@@ -1,5 +1,37 @@
This file documents the revision history for Perl extension Mojolicious.
+1.68 2011-07-29 00:00:00
+ - Moved is_ipv4 and is_ipv6 methods from Mojo::URL to
+ Mojo::IOLoop::Resolver.
+ - Improved documentation.
+
+1.67 2011-07-27 00:00:00
+ - Improved documentation.
+ - Fixed version command.
+ - Fixed small Mojo::DOM bug. (akron)
+
+1.66 2011-07-27 00:00:00
+ - Added EXPERIMENTAL detect method to Mojo::IOWatcher.
+ - Improved Mojo::IOLoop::Resolver efficiency.
+ - Improved documentation.
+ - Fixed typos. (crab)
+
+1.65 2011-07-25 00:00:00
+ - Added EXPERIMENTAL modules Mojo::IOLoop::Client,
+ Mojo::IOLoop::EventEmitter, Mojo::IOLoop::Server and
+ Mojo::IOLoop::Stream, which contain extracted functionality from
+ Mojo::IOLoop.
+ - Added EXPERIMENTAL module Mojo::IOWatcher::EV. (xantus)
+ - Removed modules Mojo::IOWatcher::Epoll and Mojo::IOWatcher::KQueue,
+ since Mojo::IOWatcher::EV is a much better alternative.
+ - Renamed Mojo::Resolver to Mojo::IOLoop::Resolver.
+ - Improved Mojolicious::Routes to automatically disable the routing
+ cache if conditions are used.
+ - Improved route constraint alternatives.
+ - Improved documentation browser CSS. (judofyr)
+ - Improved documentation.
+ - Fixed small bug in get command.
+
1.64 2011-07-10 00:00:00
- Added EXPERIMENTAL module Mojo::DOM::HTML.
- Improved documentation.
@@ -14,7 +46,7 @@ This file documents the revision history for Perl extension Mojolicious.
- Improved documentation.
1.61 2011-07-09 00:00:00
- - Added Mojo::HTML module, which contains extracted functionality
+ - Added module Mojo::HTML, which contains extracted functionality
from Mojo::DOM.
- Improved documentation.
@@ -74,9 +106,9 @@ This file documents the revision history for Perl extension Mojolicious.
disabling format detection.
1.49 2011-06-30 00:00:00
- - Added EXPERIMENTAL Mojo::IOWatcher and Mojo::Resolver modules,
+ - Added EXPERIMENTAL modules Mojo::IOWatcher and Mojo::Resolver,
which contain extracted functionality from Mojo::IOLoop.
- - Added EXPERIMENTAL Mojo::Transactor module, which contains
+ - Added EXPERIMENTAL module Mojo::Transactor, which contains
extracted functionality from Mojo::UserAgent.
- Added EXPERIMENTAL support for simple alternative placeholder
values to routes.
@@ -339,7 +371,7 @@ This file documents the revision history for Perl extension Mojolicious.
- Fixed a serious Mojo::DOM bug. (moritz)
1.14 2011-03-17 00:00:00
- - Added support for multiple dns servers to Mojo::IOLoop.
+ - Added support for multiple DNS servers to Mojo::IOLoop.
- Added config helper to Mojolicious::Plugin::Config.
- Changed resolv.conf parser in Mojo::IOLoop to use the first
nameserver.
@@ -948,7 +980,6 @@ This file documents the revision history for Perl extension Mojolicious.
- Added transparent kqueue and epoll support to daemons and client.
- Added support for listening to multiple locations to the daemons.
mojo daemon --listen http://127.0.0.1:3000
- mojo daemon --listen http://127.0.0.1:3000,file:///tmp/my.sock
mojo daemon --listen http://*:3000,http://*:3001,http://*:3002
mojo daemon --listen http://[::1]:3000
mojo daemon --listen https://*:443:/x/server.crt:/x/server.key
@@ -28,9 +28,13 @@ lib/Mojo/Headers.pm
lib/Mojo/HelloWorld.pm
lib/Mojo/Home.pm
lib/Mojo/IOLoop.pm
+lib/Mojo/IOLoop/Client.pm
+lib/Mojo/IOLoop/EventEmitter.pm
+lib/Mojo/IOLoop/Resolver.pm
+lib/Mojo/IOLoop/Server.pm
+lib/Mojo/IOLoop/Stream.pm
lib/Mojo/IOWatcher.pm
-lib/Mojo/IOWatcher/Epoll.pm
-lib/Mojo/IOWatcher/KQueue.pm
+lib/Mojo/IOWatcher/EV.pm
lib/Mojo/JSON.pm
lib/Mojo/Loader.pm
lib/Mojo/Log.pm
@@ -39,7 +43,6 @@ lib/Mojo/Message/Request.pm
lib/Mojo/Message/Response.pm
lib/Mojo/Parameters.pm
lib/Mojo/Path.pm
-lib/Mojo/Resolver.pm
lib/Mojo/Server.pm
lib/Mojo/Server/CGI.pm
lib/Mojo/Server/Daemon.pm
@@ -152,6 +155,7 @@ LICENSE
Makefile.PL
MANIFEST This list of files
MANIFEST.SKIP
+MYMETA.json
MYMETA.yml
README.pod
script/hypnotoad
@@ -179,6 +183,7 @@ t/mojo/cookie.t
t/mojo/cookiejar.t
t/mojo/date.t
t/mojo/dom.t
+t/mojo/eventemitter.t
t/mojo/fastcgi.t
t/mojo/headers.t
t/mojo/home.t
@@ -186,8 +191,7 @@ t/mojo/hypnotoad.t
t/mojo/ioloop.t
t/mojo/ioloop_tls.t
t/mojo/iowatcher.t
-t/mojo/iowatcher_epoll.t
-t/mojo/iowatcher_kqueue.t
+t/mojo/iowatcher_ev.t
t/mojo/json.t
t/mojo/lib/BaseTest/Base1.pm
t/mojo/lib/BaseTest/Base2.pm
@@ -206,6 +210,7 @@ t/mojo/morbo.t
t/mojo/parameters.t
t/mojo/path.t
t/mojo/psgi.t
+t/mojo/resolver.t
t/mojo/resolver_online.t
t/mojo/server.t
t/mojo/template.t
@@ -285,4 +290,5 @@ t/mojolicious/websocket_proxy_lite_app.t
t/mojolicious/websocket_tls_proxy_lite_app.t
t/pod.t
t/pod_coverage.t
-META.yml Module meta-data (added by MakeMaker)
+META.yml Module YAML meta-data (added by MakeMaker)
+META.json Module JSON meta-data (added by MakeMaker)
@@ -0,0 +1,86 @@
+{
+ "abstract" : "The Web In A Box!",
+ "author" : [
+ "Sebastian Riedel <sri@cpan.org>"
+ ],
+ "dynamic_config" : 1,
+ "generated_by" : "ExtUtils::MakeMaker version 6.58, CPAN::Meta::Converter version 2.110930",
+ "license" : [
+ "artistic_2"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+ "version" : "2"
+ },
+ "name" : "Mojolicious",
+ "no_index" : {
+ "directory" : [
+ "t",
+ "inc",
+ "t"
+ ]
+ },
+ "prereqs" : {
+ "build" : {
+ "requires" : {}
+ },
+ "configure" : {
+ "requires" : {}
+ },
+ "runtime" : {
+ "requires" : {
+ "B" : 0,
+ "Carp" : 0,
+ "Cwd" : 0,
+ "Data::Dumper" : 0,
+ "Digest::MD5" : 0,
+ "Encode" : 0,
+ "Errno" : 0,
+ "Exporter" : 0,
+ "ExtUtils::MakeMaker" : 0,
+ "Fcntl" : 0,
+ "File::Basename" : 0,
+ "File::Copy" : 0,
+ "File::Find" : 0,
+ "File::Path" : 0,
+ "File::Spec" : 0,
+ "File::Temp" : 0,
+ "FindBin" : 0,
+ "Getopt::Long" : 0,
+ "I18N::LangTags" : 0,
+ "I18N::LangTags::Detect" : 0,
+ "IO::File" : 0,
+ "IO::Poll" : 0,
+ "IO::Socket" : 0,
+ "IO::Socket::INET" : 0,
+ "List::Util" : 0,
+ "Locale::Maketext" : 0,
+ "MIME::Base64" : 0,
+ "MIME::QuotedPrint" : 0,
+ "POSIX" : 0,
+ "Scalar::Util" : 0,
+ "Socket" : 0,
+ "Sys::Hostname" : 0,
+ "Test::Harness" : 0,
+ "Test::More" : 0,
+ "Time::HiRes" : 0,
+ "perl" : "5.008007"
+ }
+ }
+ },
+ "release_status" : "stable",
+ "resources" : {
+ "bugtracker" : {
+ "web" : "http://github.com/kraih/mojo/issues"
+ },
+ "homepage" : "http://mojolicio.us",
+ "license" : [
+ "http://dev.perl.org/licenses/"
+ ],
+ "repository" : {
+ "url" : "http://github.com/kraih/mojo"
+ },
+ "x_MailingList" : "http://groups.google.com/group/mojolicious"
+ },
+ "version" : "1.68"
+}
@@ -1,63 +1,62 @@
---- #YAML:1.0
-name: Mojolicious
-version: 1.64
-abstract: The Web In A Box!
+---
+abstract: 'The Web In A Box!'
author:
- - Sebastian Riedel <sri@cpan.org>
-license: artistic_2
-distribution_type: module
-configure_requires: {}
-build_requires: {}
+ - 'Sebastian Riedel <sri@cpan.org>'
+build_requires: {}
+configure_requires: {}
+dynamic_config: 1
+generated_by: 'ExtUtils::MakeMaker version 6.58, CPAN::Meta::Converter version 2.110930'
+license: artistic_2
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
+name: Mojolicious
+no_index:
+ directory:
+ - t
+ - inc
+ - t
requires:
- B: 0
- Carp: 0
- Cwd: 0
- Data::Dumper: 0
- Digest::MD5: 0
- Encode: 0
- Errno: 0
- Exporter: 0
- ExtUtils::MakeMaker: 0
- Fcntl: 0
- File::Basename: 0
- File::Copy: 0
- File::Find: 0
- File::Path: 0
- File::Spec: 0
- File::Temp: 0
- FindBin: 0
- Getopt::Long: 0
- I18N::LangTags: 0
- I18N::LangTags::Detect: 0
- IO::File: 0
- IO::Poll: 0
- IO::Socket: 0
- IO::Socket::INET: 0
- IO::Socket::UNIX: 0
- List::Util: 0
- Locale::Maketext: 0
- MIME::Base64: 0
- MIME::QuotedPrint: 0
- perl: 5.008007
- POSIX: 0
- Scalar::Util: 0
- Socket: 0
- Sys::Hostname: 0
- Test::Harness: 0
- Test::More: 0
- Time::HiRes: 0
+ B: 0
+ Carp: 0
+ Cwd: 0
+ Data::Dumper: 0
+ Digest::MD5: 0
+ Encode: 0
+ Errno: 0
+ Exporter: 0
+ ExtUtils::MakeMaker: 0
+ Fcntl: 0
+ File::Basename: 0
+ File::Copy: 0
+ File::Find: 0
+ File::Path: 0
+ File::Spec: 0
+ File::Temp: 0
+ FindBin: 0
+ Getopt::Long: 0
+ I18N::LangTags: 0
+ I18N::LangTags::Detect: 0
+ IO::File: 0
+ IO::Poll: 0
+ IO::Socket: 0
+ IO::Socket::INET: 0
+ List::Util: 0
+ Locale::Maketext: 0
+ MIME::Base64: 0
+ MIME::QuotedPrint: 0
+ POSIX: 0
+ Scalar::Util: 0
+ Socket: 0
+ Sys::Hostname: 0
+ Test::Harness: 0
+ Test::More: 0
+ Time::HiRes: 0
+ perl: 5.008007
resources:
- bugtracker: http://github.com/kraih/mojo/issues
- homepage: http://mojolicio.us
- license: http://dev.perl.org/licenses/
- MailingList: http://groups.google.com/group/mojolicious
- repository: http://github.com/kraih/mojo
-no_index:
- directory:
- - t
- - inc
- - t
-generated_by: ExtUtils::MakeMaker version 6.57_05
-meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: 1.4
+ bugtracker: http://github.com/kraih/mojo/issues
+ homepage: http://mojolicio.us
+ license: http://dev.perl.org/licenses/
+ repository: http://github.com/kraih/mojo
+ x_MailingList: http://groups.google.com/group/mojolicious
+version: 1.68
@@ -0,0 +1,87 @@
+{
+ "abstract" : "The Web In A Box!",
+ "author" : [
+ "Sebastian Riedel <sri@cpan.org>"
+ ],
+ "dynamic_config" : 0,
+ "generated_by" : "ExtUtils::MakeMaker version 6.58, CPAN::Meta::Converter version 2.110930",
+ "license" : [
+ "artistic_2"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+ "version" : "2"
+ },
+ "name" : "Mojolicious",
+ "no_index" : {
+ "directory" : [
+ "t",
+ "inc",
+ "t"
+ ]
+ },
+ "prereqs" : {
+ "build" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : 0
+ }
+ },
+ "configure" : {
+ "requires" : {}
+ },
+ "runtime" : {
+ "requires" : {
+ "B" : 0,
+ "Carp" : 0,
+ "Cwd" : 0,
+ "Data::Dumper" : 0,
+ "Digest::MD5" : 0,
+ "Encode" : 0,
+ "Errno" : 0,
+ "Exporter" : 0,
+ "ExtUtils::MakeMaker" : 0,
+ "Fcntl" : 0,
+ "File::Basename" : 0,
+ "File::Copy" : 0,
+ "File::Find" : 0,
+ "File::Path" : 0,
+ "File::Spec" : 0,
+ "File::Temp" : 0,
+ "FindBin" : 0,
+ "Getopt::Long" : 0,
+ "I18N::LangTags" : 0,
+ "I18N::LangTags::Detect" : 0,
+ "IO::File" : 0,
+ "IO::Poll" : 0,
+ "IO::Socket" : 0,
+ "IO::Socket::INET" : 0,
+ "List::Util" : 0,
+ "Locale::Maketext" : 0,
+ "MIME::Base64" : 0,
+ "MIME::QuotedPrint" : 0,
+ "POSIX" : 0,
+ "Scalar::Util" : 0,
+ "Socket" : 0,
+ "Sys::Hostname" : 0,
+ "Test::Harness" : 0,
+ "Test::More" : 0,
+ "Time::HiRes" : 0
+ }
+ }
+ },
+ "release_status" : "stable",
+ "resources" : {
+ "bugtracker" : {
+ "web" : "http://github.com/kraih/mojo/issues"
+ },
+ "homepage" : "http://mojolicio.us",
+ "license" : [
+ "http://dev.perl.org/licenses/"
+ ],
+ "repository" : {
+ "url" : "http://github.com/kraih/mojo"
+ },
+ "x_MailingList" : "http://groups.google.com/group/mojolicious"
+ },
+ "version" : "1.68"
+}
@@ -2,11 +2,11 @@
abstract: 'The Web In A Box!'
author:
- 'Sebastian Riedel <sri@cpan.org>'
-build_requires: {}
+build_requires:
+ ExtUtils::MakeMaker: 0
configure_requires: {}
-distribution_type: module
dynamic_config: 0
-generated_by: 'ExtUtils::MakeMaker version 6.57_05'
+generated_by: 'ExtUtils::MakeMaker version 6.58, CPAN::Meta::Converter version 2.110930'
license: artistic_2
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -42,7 +42,6 @@ requires:
IO::Poll: 0
IO::Socket: 0
IO::Socket::INET: 0
- IO::Socket::UNIX: 0
List::Util: 0
Locale::Maketext: 0
MIME::Base64: 0
@@ -54,11 +53,10 @@ requires:
Test::Harness: 0
Test::More: 0
Time::HiRes: 0
- perl: 5.008007
resources:
- MailingList: http://groups.google.com/group/mojolicious
bugtracker: http://github.com/kraih/mojo/issues
homepage: http://mojolicio.us
license: http://dev.perl.org/licenses/
repository: http://github.com/kraih/mojo
-version: 1.64
+ x_MailingList: http://groups.google.com/group/mojolicious
+version: 1.68
@@ -68,7 +68,6 @@ WriteMakefile(
'IO::Poll' => 0,
'IO::Socket' => 0,
'IO::Socket::INET' => 0,
- 'IO::Socket::UNIX' => 0,
'List::Util' => 0,
'Locale::Maketext' => 0,
'MIME::Base64' => 0,
@@ -38,8 +38,8 @@ TLS, Bonjour, IDNA, Comet (long polling), chunking and multipart support.
=item *
-Built-in async IO web server supporting epoll, kqueue, UNIX domain sockets
-and hot deployment, perfect for embedding.
+Built-in async I/O web server supporting libev and hot deployment, perfect
+for embedding.
=item *
@@ -59,7 +59,7 @@ Fresh code based upon years of experience developing L<Catalyst>.
All you need is a oneliner, it takes less than a minute.
- sudo sh -c "curl -L cpanmin.us | perl - Mojolicious"
+ $ sudo sh -c "curl -L cpanmin.us | perl - Mojolicious"
=head2 Getting Started
@@ -72,12 +72,12 @@ These three lines are a whole web application.
app->start;
To run this example with the built-in development web server just put the
-code into a file and execute it with C<perl>.
+code into a file and start it with C<morbo>.
- % perl hello.pl daemon
+ $ morbo hello.pl
Server available at http://127.0.0.1:3000.
- % curl http://127.0.0.1:3000/
+ $ curl http://127.0.0.1:3000/
Hello World!
=head2 Duct Tape For The HTML5 Web
@@ -122,9 +122,10 @@ Web development for humans, making hard things possible and everything fun.
__DATA__
@@ clock.html.ep
- % my ($second, $minute, $hour) = (localtime(time))[0, 1, 2];
+ % use Time::Piece;
+ % my $now = localtime;
<%= link_to clock => begin %>
- The time is <%= $hour %>:<%= $minute %>:<%= $second %>.
+ The time is <%= $now->hms %>.
<% end %>
=head2 Growing
@@ -200,7 +201,7 @@ especially when working in a team.
# All common HTTP verbs are supported
$example->post('/title')->to('#title');
- # ... and much, much more
+ # ...and much, much more
# (including multiple, auto-discovered controllers)
$r->websocket('/echo')->to('realtime#echo');
}
@@ -210,9 +211,10 @@ especially when working in a team.
Through all of these changes, your action code and templates can stay almost
exactly the same.
- % my ($second, $minute, $hour) = (localtime(time))[0, 1, 2];
+ % use Time::Piece;
+ % my $now = localtime;
<%= link_to clock => begin %>
- The time is <%= $hour %>:<%= $minute %>:<%= $second %>.
+ The time is <%= $now->hms %>.
<% end %>
Mojolicious has been designed from the ground up for a fun and unique
@@ -52,7 +52,7 @@ Mojo::IOLoop->listen(
print <<'EOF';
Starting server on port 3000.
Try something like "ab -c 30 -n 100000 -k http://127.0.0.1:3000/" for testing.
-On a MacBook Pro 13" this results in about 25k req/s.
+On a MacBook Pro 13" this results in about 20k req/s.
EOF
# Start loop
@@ -240,19 +240,17 @@ sub run {
for my $namespace (@{$self->namespaces}) {
# Search
- if (my $modules = Mojo::Loader->search($namespace)) {
- for my $module (@$modules) {
-
- # Load
- if (my $e = Mojo::Loader->load($module)) { die $e }
-
- # Seen
- my $command = $module;
- $command =~ s/^$namespace\:://;
- push @$commands, [$command => $module]
- unless $seen->{$command};
- $seen->{$command} = 1;
- }
+ for my $module (@{Mojo::Loader->search($namespace)}) {
+
+ # Load
+ if (my $e = Mojo::Loader->load($module)) { die $e }
+
+ # Seen
+ my $command = $module;
+ $command =~ s/^$namespace\:://;
+ push @$commands, [$command => $module]
+ unless $seen->{$command};
+ $seen->{$command} = 1;
}
}
@@ -470,6 +470,206 @@ Mojo::DOM::CSS - CSS3 Selector Engine
L<Mojo::DOM::CSS> is the CSS3 selector engine used by L<Mojo::DOM>.
Note that this module is EXPERIMENTAL and might change without warning!
+=head1 SELECTORS
+
+All CSS3 selectors that make sense for a standalone parser are supported.
+
+=head2 C<*>
+
+Any element.
+
+ my $first = $css->select('*');
+
+=head2 C<E>
+
+An element of type C<E>.
+
+ my $title = $css->select('title');
+
+=head2 C<E[foo]>
+
+An C<E> element with a C<foo> attribute.
+
+ my $links = $css->select('a[href]');
+
+=head2 C<E[foo="bar"]>
+
+An C<E> element whose C<foo> attribute value is exactly equal to C<bar>.
+
+ my $fields = $css->select('input[name="foo"]');
+
+=head2 C<E[foo~="bar"]>
+
+An C<E> element whose C<foo> attribute value is a list of
+whitespace-separated values, one of which is exactly equal to C<bar>.
+
+ my $fields = $css->select('input[name~="foo"]');
+
+=head2 C<E[foo^="bar"]>
+
+An C<E> element whose C<foo> attribute value begins exactly with the string
+C<bar>.
+
+ my $fields = $css->select('input[name^="f"]');
+
+=head2 C<E[foo$="bar"]>
+
+An C<E> element whose C<foo> attribute value ends exactly with the string
+C<bar>.
+
+ my $fields = $css->select('input[name$="o"]');
+
+=head2 C<E[foo*="bar"]>
+
+An C<E> element whose C<foo> attribute value contains the substring C<bar>.
+
+ my $fields = $css->select('input[name*="fo"]');
+
+=head2 C<E:root>
+
+An C<E> element, root of the document.
+
+ my $root = $css->select(':root');
+
+=head2 C<E:checked>
+
+A user interface element C<E> which is checked (for instance a radio-button
+or checkbox).
+
+ my $input = $css->select(':checked');
+
+=head2 C<E:empty>
+
+An C<E> element that has no children (including text nodes).
+
+ my $empty = $css->select(':empty');
+
+=head2 C<E:nth-child(n)>
+
+An C<E> element, the C<n-th> child of its parent.
+
+ my $third = $css->select('div:nth-child(3)');
+ my $odd = $css->select('div:nth-child(odd)');
+ my $even = $css->select('div:nth-child(even)');
+ my $top3 = $css->select('div:nth-child(-n+3)');
+
+=head2 C<E:nth-last-child(n)>
+
+An C<E> element, the C<n-th> child of its parent, counting from the last one.
+
+ my $third = $css->select('div:nth-last-child(3)');
+ my $odd = $css->select('div:nth-last-child(odd)');
+ my $even = $css->select('div:nth-last-child(even)');
+ my $bottom3 = $css->select('div:nth-last-child(-n+3)');
+
+=head2 C<E:nth-of-type(n)>
+
+An C<E> element, the C<n-th> sibling of its type.
+
+ my $third = $css->select('div:nth-of-type(3)');
+ my $odd = $css->select('div:nth-of-type(odd)');
+ my $even = $css->select('div:nth-of-type(even)');
+ my $top3 = $css->select('div:nth-of-type(-n+3)');
+
+=head2 C<E:nth-last-of-type(n)>
+
+An C<E> element, the C<n-th> sibling of its type, counting from the last one.
+
+ my $third = $css->select('div:nth-last-of-type(3)');
+ my $odd = $css->select('div:nth-last-of-type(odd)');
+ my $even = $css->select('div:nth-last-of-type(even)');
+ my $bottom3 = $css->select('div:nth-last-of-type(-n+3)');
+
+=head2 C<E:first-child>
+
+An C<E> element, first child of its parent.
+
+ my $first = $css->select('div p:first-child');
+
+=head2 C<E:last-child>
+
+An C<E> element, last child of its parent.
+
+ my $last = $css->select('div p:last-child');
+
+=head2 C<E:first-of-type>
+
+An C<E> element, first sibling of its type.
+
+ my $first = $css->select('div p:first-of-type');
+
+=head2 C<E:last-of-type>
+
+An C<E> element, last sibling of its type.
+
+ my $last = $css->select('div p:last-of-type');
+
+=head2 C<E:only-child>
+
+An C<E> element, only child of its parent.
+
+ my $lonely = $css->select('div p:only-child');
+
+=head2 C<E:only-of-type>
+
+An C<E> element, only sibling of its type.
+
+ my $lonely = $css->select('div p:only-of-type');
+
+=head2 C<E.warning>
+
+ my $warning = $css->select('div.warning');
+
+An C<E> element whose class is "warning".
+
+=head2 C<E#myid>
+
+ my $foo = $css->select('div#foo');
+
+An C<E> element with C<ID> equal to "myid".
+
+=head2 C<E:not(s)>
+
+An C<E> element that does not match simple selector C<s>.
+
+ my $others = $css->select('div p:not(:first-child)');
+
+=head2 C<E F>
+
+An C<F> element descendant of an C<E> element.
+
+ my $headlines = $css->select('div h1');
+
+=head2 C<E E<gt> F>
+
+An C<F> element child of an C<E> element.
+
+ my $headlines = $css->select('html > body > div > h1');
+
+=head2 C<E + F>
+
+An C<F> element immediately preceded by an C<E> element.
+
+ my $second = $css->select('h1 + h2');
+
+=head2 C<E ~ F>
+
+An C<F> element preceded by an C<E> element.
+
+ my $second = $css->select('h1 ~ h2');
+
+=head2 C<E, F, G>
+
+Elements of type C<E>, C<F> and C<G>.
+
+ my $headlines = $css->select('h1, h2, h3');
+
+=head2 C<E[foo=bar][bar=baz]>
+
+An C<E> element whose attributes match all following attribute selectors.
+
+ my $links = $css->select('a[foo^="b"][foo$="ar"]');
+
=head1 ATTRIBUTES
L<Mojo::DOM::CSS> implements the following attributes.
@@ -2,7 +2,6 @@ package Mojo::DOM::Collection;
use Mojo::Base -base;
use overload 'bool' => sub {1}, '""' => sub { shift->to_xml }, fallback => 1;
-# "Hi, Super Nintendo Chalmers!"
sub new {
my $class = shift;
bless shift, ref $class || $class;
@@ -88,6 +88,9 @@ $HTML_BLOCK{$_}++ for @BLOCK_TAGS;
has [qw/charset xml/];
has tree => sub { ['root'] };
+# "No one believes me.
+# I believe you, dad.
+# Then can you stop the cats from swearing?"
sub parse {
my ($self, $html) = @_;
@@ -99,7 +99,7 @@ sub append { shift->_add(1, @_) }
sub append_content {
my ($self, $new) = @_;
my $tree = $self->tree;
- push @$tree, @{_parent($self->_parse("$new"), $tree->[3])};
+ push @$tree, @{_parent($self->_parse("$new"), $tree)};
return $self;
}
@@ -175,6 +175,7 @@ sub content_xml {
return $result;
}
+# "But I was going to loot you a present."
sub find {
my ($self, $selector) = @_;
@@ -254,7 +255,7 @@ sub prepend_content {
my ($self, $new) = @_;
my $tree = $self->tree;
splice @$tree, $tree->[0] eq 'root' ? 1 : 4, 0,
- @{_parent($self->_parse("$new"), $tree->[3])};
+ @{_parent($self->_parse("$new"), $tree)};
return $self;
}
@@ -378,6 +379,7 @@ sub type {
return $self;
}
+# "I want to set the record straight, I thought the cop was a prostitute."
sub xml {
my $self = shift;
return $self->[0]->xml if @_ == 0;
@@ -482,206 +484,6 @@ selector support.
It will even try to interpret broken XML, so you should not use it for
validation.
-=head1 SELECTORS
-
-All CSS3 selectors that make sense for a standalone parser are supported.
-
-=head2 C<*>
-
-Any element.
-
- my $first = $dom->at('*');
-
-=head2 C<E>
-
-An element of type C<E>.
-
- my $title = $dom->at('title');
-
-=head2 C<E[foo]>
-
-An C<E> element with a C<foo> attribute.
-
- my $links = $dom->find('a[href]');
-
-=head2 C<E[foo="bar"]>
-
-An C<E> element whose C<foo> attribute value is exactly equal to C<bar>.
-
- my $fields = $dom->find('input[name="foo"]');
-
-=head2 C<E[foo~="bar"]>
-
-An C<E> element whose C<foo> attribute value is a list of
-whitespace-separated values, one of which is exactly equal to C<bar>.
-
- my $fields = $dom->find('input[name~="foo"]');
-
-=head2 C<E[foo^="bar"]>
-
-An C<E> element whose C<foo> attribute value begins exactly with the string
-C<bar>.
-
- my $fields = $dom->find('input[name^="f"]');
-
-=head2 C<E[foo$="bar"]>
-
-An C<E> element whose C<foo> attribute value ends exactly with the string
-C<bar>.
-
- my $fields = $dom->find('input[name$="o"]');
-
-=head2 C<E[foo*="bar"]>
-
-An C<E> element whose C<foo> attribute value contains the substring C<bar>.
-
- my $fields = $dom->find('input[name*="fo"]');
-
-=head2 C<E:root>
-
-An C<E> element, root of the document.
-
- my $root = $dom->at(':root');
-
-=head2 C<E:checked>
-
-A user interface element C<E> which is checked (for instance a radio-button
-or checkbox).
-
- my $input = $dom->at(':checked');
-
-=head2 C<E:empty>
-
-An C<E> element that has no children (including text nodes).
-
- my $empty = $dom->find(':empty');
-
-=head2 C<E:nth-child(n)>
-
-An C<E> element, the C<n-th> child of its parent.
-
- my $third = $dom->at('div:nth-child(3)');
- my $odd = $dom->find('div:nth-child(odd)');
- my $even = $dom->find('div:nth-child(even)');
- my $top3 = $dom->find('div:nth-child(-n+3)');
-
-=head2 C<E:nth-last-child(n)>
-
-An C<E> element, the C<n-th> child of its parent, counting from the last one.
-
- my $third = $dom->at('div:nth-last-child(3)');
- my $odd = $dom->find('div:nth-last-child(odd)');
- my $even = $dom->find('div:nth-last-child(even)');
- my $bottom3 = $dom->find('div:nth-last-child(-n+3)');
-
-=head2 C<E:nth-of-type(n)>
-
-An C<E> element, the C<n-th> sibling of its type.
-
- my $third = $dom->at('div:nth-of-type(3)');
- my $odd = $dom->find('div:nth-of-type(odd)');
- my $even = $dom->find('div:nth-of-type(even)');
- my $top3 = $dom->find('div:nth-of-type(-n+3)');
-
-=head2 C<E:nth-last-of-type(n)>
-
-An C<E> element, the C<n-th> sibling of its type, counting from the last one.
-
- my $third = $dom->at('div:nth-last-of-type(3)');
- my $odd = $dom->find('div:nth-last-of-type(odd)');
- my $even = $dom->find('div:nth-last-of-type(even)');
- my $bottom3 = $dom->find('div:nth-last-of-type(-n+3)');
-
-=head2 C<E:first-child>
-
-An C<E> element, first child of its parent.
-
- my $first = $dom->at('div p:first-child');
-
-=head2 C<E:last-child>
-
-An C<E> element, last child of its parent.
-
- my $last = $dom->at('div p:last-child');
-
-=head2 C<E:first-of-type>
-
-An C<E> element, first sibling of its type.
-
- my $first = $dom->at('div p:first-of-type');
-
-=head2 C<E:last-of-type>
-
-An C<E> element, last sibling of its type.
-
- my $last = $dom->at('div p:last-of-type');
-
-=head2 C<E:only-child>
-
-An C<E> element, only child of its parent.
-
- my $lonely = $dom->at('div p:only-child');
-
-=head2 C<E:only-of-type>
-
-An C<E> element, only sibling of its type.
-
- my $lonely = $dom->at('div p:only-of-type');
-
-=head2 C<E.warning>
-
- my $warning = $dom->at('div.warning');
-
-An C<E> element whose class is "warning".
-
-=head2 C<E#myid>
-
- my $foo = $dom->at('div#foo');
-
-An C<E> element with C<ID> equal to "myid".
-
-=head2 C<E:not(s)>
-
-An C<E> element that does not match simple selector C<s>.
-
- my $others = $dom->at('div p:not(:first-child)');
-
-=head2 C<E F>
-
-An C<F> element descendant of an C<E> element.
-
- my $headlines = $dom->find('div h1');
-
-=head2 C<E E<gt> F>
-
-An C<F> element child of an C<E> element.
-
- my $headlines = $dom->find('html > body > div > h1');
-
-=head2 C<E + F>
-
-An C<F> element immediately preceded by an C<E> element.
-
- my $second = $dom->find('h1 + h2');
-
-=head2 C<E ~ F>
-
-An C<F> element preceded by an C<E> element.
-
- my $second = $dom->find('h1 ~ h2');
-
-=head2 C<E, F, G>
-
-Elements of type C<E>, C<F> and C<G>.
-
- my $headlines = $dom->find('h1, h2, h3');
-
-=head2 C<E[foo=bar][bar=baz]>
-
-An C<E> element whose attributes match all following attribute selectors.
-
- my $links = $dom->find('a[foo^="b"][foo$="ar"]');
-
=head1 CASE SENSITIVITY
L<Mojo::DOM> defaults to HTML5 semantics, that means all tags and attributes
@@ -749,6 +551,7 @@ Append to element content.
my $result = $dom->at('html title');
Find a single element with CSS3 selectors.
+All selectors from L<Mojo::DOM::CSS> are supported.
=head2 C<attrs>
@@ -795,6 +598,7 @@ Render content of this element to XML.
Find elements with CSS3 selectors and return a L<Mojo::DOM::Collection>
object.
+All selectors from L<Mojo::DOM::CSS> are supported.
print $dom->find('div')->[23]->text;
@@ -814,7 +618,7 @@ Parent of element.
$dom = $dom->parse('<foo bar="baz">test</foo>');
-Parse HTML5/XML document.
+Parse HTML5/XML document with L<Mojo::DOM::HTML>.
=head2 C<prepend>
@@ -102,6 +102,7 @@ sub add {
return $self;
}
+sub cache_control { scalar shift->header('Cache-Control' => @_) }
sub connection { scalar shift->header(Connection => @_) }
sub content_disposition { scalar shift->header('Content-Disposition' => @_) }
sub content_length { scalar shift->header('Content-Length' => @_) }
@@ -116,6 +117,7 @@ sub cookie { scalar shift->header(Cookie => @_) }
sub date { scalar shift->header(Date => @_) }
sub dnt { scalar shift->header(DNT => @_) }
sub expect { scalar shift->header(Expect => @_) }
+sub expires { scalar shift->header(Expires => @_) }
sub from_hash {
my $self = shift;
@@ -379,6 +381,13 @@ Add one or more header lines.
Shortcut for the C<Authorization> header.
+=head2 C<cache_control>
+
+ my $cache_control = $headers->cache_control;
+ $headers = $headers->cache_control('max-age=1, no-cache');
+
+Shortcut for the C<Cache-Control> header.
+
=head2 C<connection>
my $connection = $headers->connection;
@@ -450,6 +459,13 @@ Note that this method is EXPERIMENTAL and might change without warning!
Shortcut for the C<Expect> header.
+=head2 C<expires>
+
+ my $expires = $headers->expires;
+ $headers = $headers->expires('Thu, 01 Dec 1994 16:00:00 GMT');
+
+Shortcut for the C<Expires> header.
+
=head2 C<from_hash>
$headers = $headers->from_hash({'Content-Type' => 'text/html'});
@@ -0,0 +1,256 @@
+package Mojo::IOLoop::Client;
+use Mojo::Base 'Mojo::IOLoop::EventEmitter';
+
+use IO::Socket::INET;
+use Scalar::Util 'weaken';
+use Socket qw/IPPROTO_TCP SO_ERROR TCP_NODELAY/;
+
+# IPv6 support requires IO::Socket::IP
+use constant IPV6 => $ENV{MOJO_NO_IPV6}
+ ? 0
+ : eval 'use IO::Socket::IP 0.06 (); 1';
+
+# TLS support requires IO::Socket::SSL
+use constant TLS => $ENV{MOJO_NO_TLS}
+ ? 0
+ : eval 'use IO::Socket::SSL 1.43 "inet4"; 1';
+use constant TLS_READ => TLS ? IO::Socket::SSL::SSL_WANT_READ() : 0;
+use constant TLS_WRITE => TLS ? IO::Socket::SSL::SSL_WANT_WRITE() : 0;
+
+has resolver => sub {
+ require Mojo::IOLoop::Resolver;
+ Mojo::IOLoop::Resolver->new;
+};
+
+sub DESTROY {
+ my $self = shift;
+ return if $self->{connected};
+ return unless my $resolver = $self->resolver;
+ return unless my $loop = $resolver->ioloop;
+ return unless my $watcher = $loop->iowatcher;
+ $watcher->cancel($self->{timer}) if $self->{timer};
+ $watcher->remove($self->{handle}) if $self->{handle};
+}
+
+sub connect {
+ my $self = shift;
+ my $args = ref $_[0] ? $_[0] : {@_};
+
+ # Lookup
+ if (!$args->{handle} && (my $address = $args->{address})) {
+ $self->resolver->lookup(
+ $address => sub {
+ $args->{address} = $_[1] || $args->{address};
+ $self->_connect($args);
+ }
+ );
+ }
+
+ # Connect
+ else { $self->_connect($args) }
+}
+
+sub _connect {
+ my ($self, $args) = @_;
+
+ # New socket
+ my $handle;
+ my $watcher = $self->resolver->ioloop->iowatcher;
+ my $timeout = $args->{timeout} || 3;
+ unless ($handle = $args->{handle}) {
+ my %options = (
+ Blocking => 0,
+ PeerAddr => $args->{address},
+ PeerPort => $args->{port} || ($args->{tls} ? 443 : 80),
+ Proto => 'tcp',
+ %{$args->{args} || {}}
+ );
+ $options{PeerAddr} =~ s/[\[\]]//g if $options{PeerAddr};
+ my $class = IPV6 ? 'IO::Socket::IP' : 'IO::Socket::INET';
+ return $self->emit(error => "Couldn't connect.")
+ unless $handle = $class->new(%options);
+
+ # Timer
+ $self->{timer} =
+ $watcher->timer($timeout,
+ sub { $self->emit(error => 'Connect timeout.') });
+
+ # IPv6 needs an early start
+ $handle->connect if IPV6;
+ }
+
+ # Non-blocking
+ $handle->blocking(0);
+
+ # Disable Nagle's algorithm
+ setsockopt $handle, IPPROTO_TCP, TCP_NODELAY, 1;
+
+ # TLS
+ if ($args->{tls}) {
+
+ # No TLS support
+ return $self->emit(
+ error => 'IO::Socket::SSL 1.43 required for TLS support.')
+ unless TLS;
+
+ # Upgrade
+ weaken $self;
+ my %options = (
+ SSL_startHandshake => 0,
+ SSL_error_trap => sub {
+ my $handle = delete $self->{handle};
+ my $watcher = $self->resolver->ioloop->iowatcher;
+ $watcher->remove($handle);
+ $watcher->cancel($self->{timer});
+ close $handle;
+ $self->emit(error => $_[1]);
+ },
+ SSL_cert_file => $args->{tls_cert},
+ SSL_key_file => $args->{tls_key},
+ SSL_verify_mode => 0x00,
+ SSL_create_ctx_callback =>
+ sub { Net::SSLeay::CTX_sess_set_cache_size(shift, 128) },
+ Timeout => $timeout,
+ %{$args->{tls_args} || {}}
+ );
+ $self->{tls} = 1;
+ return $self->emit(error => 'TLS upgrade failed.')
+ unless $handle = IO::Socket::SSL->start_SSL($handle, %options);
+ }
+
+ # Start writing right away
+ $self->{handle} = $handle;
+ $watcher->add(
+ $handle,
+ on_readable => sub { $self->_connecting },
+ on_writable => sub { $self->_connecting }
+ );
+}
+
+sub _connecting {
+ my $self = shift;
+
+ # Switch between reading and writing
+ my $handle = $self->{handle};
+ my $watcher = $self->resolver->ioloop->iowatcher;
+ if ($self->{tls} && !$handle->connect_SSL) {
+ my $error = $IO::Socket::SSL::SSL_ERROR;
+ if ($error == TLS_READ) { $watcher->not_writing($handle) }
+ elsif ($error == TLS_WRITE) { $watcher->writing($handle) }
+ return;
+ }
+
+ # Check for errors
+ return $self->emit(error => $! = $handle->sockopt(SO_ERROR))
+ unless $handle->connected;
+
+ # Connected
+ $self->{connected} = 1;
+ $watcher->cancel($self->{timer}) if $self->{timer};
+ $watcher->remove($handle);
+ $self->emit(connect => $handle);
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Mojo::IOLoop::Client - IOLoop Socket Client
+
+=head1 SYNOPSIS
+
+ use Mojo::IOLoop::Client;
+
+ # Create socket connection
+ my $client = Mojo::IOLoop::Client->new;
+ $client->on(connect => sub {
+ my ($self, $handle) = @_;
+ ...
+ });
+ $client->on(error => sub {
+ my ($self, $error) = @_;
+ ...
+ });
+ $client->connect(address => 'mojolicio.us', port => 80);
+
+=head1 DESCRIPTION
+
+L<Mojo::IOLoop::Client> performs non-blocking socket connections for
+L<Mojo::IOLoop>.
+Note that this module is EXPERIMENTAL and might change without warning!
+
+=head1 ATTRIBUTES
+
+L<Mojo::IOLoop::Client> implements the following attributes.
+
+=head2 C<resolver>
+
+ my $resolver = $client->resolver;
+ $client = $client->resolver(Mojo::IOLoop::Resolver->new);
+
+DNS stub resolver, usually a L<Mojo::IOLoop::Resolver> object.
+
+=head1 METHODS
+
+L<Mojo::IOLoop::Client> inherits all methods from
+L<Mojo::IOLoop::EventEmitter> and implements the following new ones.
+
+=head2 C<connect>
+
+ $client->connect(
+ address => '127.0.0.1',
+ port => 3000
+ );
+
+Open a socket connection to a remote host.
+Note that TLS support depends on L<IO::Socket::SSL> and IPv6 support on
+L<IO::Socket::IP>.
+
+These options are currently available:
+
+=over 2
+
+=item C<address>
+
+Address or host name of the peer to connect to.
+
+=item C<handle>
+
+Use an already prepared handle.
+
+=item C<port>
+
+Port to connect to.
+
+=item C<tls>
+
+Enable TLS.
+
+=item C<tls_cert>
+
+Path to the TLS certificate file.
+
+=item C<tls_key>
+
+Path to the TLS key file.
+
+=back
+
+=head1 EVENTS
+
+L<Mojo::IOLoop::Client> can emit the following events.
+
+=head2 C<connect>
+
+Emitted once the connection is established.
+
+=head2 C<error>
+
+Emitted if an error happens on the connection.
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>.
+
+=cut
@@ -0,0 +1,143 @@
+package Mojo::IOLoop::EventEmitter;
+use Mojo::Base -base;
+
+use Scalar::Util 'weaken';
+
+use constant DEBUG => $ENV{MOJO_EVENTEMITTER_DEBUG} || 0;
+
+# "Back you robots!
+# Nobody ruins my family vacation but me!
+# And maybe the boy."
+sub emit {
+ my $self = shift;
+ my $name = shift;
+
+ # Emit event sequentially to all subscribers
+ my @subscribers = @{$self->subscribers($name)};
+ warn "EMIT $name (" . scalar(@subscribers) . ")\n" if DEBUG;
+ for my $cb (@subscribers) {
+ $self->emit('error', qq/Event "$name" failed: $@/)
+ if !eval { $self->$cb(@_); 1 } && $name ne 'error';
+ }
+
+ return $self;
+}
+
+sub on {
+ my ($self, $name, $cb) = @_;
+ my $subscribers = $self->{events}->{$name} ||= [];
+ push @$subscribers, $cb;
+ return $cb;
+}
+
+sub once {
+ my ($self, $name, $cb) = @_;
+ my $wrapper;
+ $wrapper = sub {
+ my $self = shift;
+ $self->$cb(@_);
+ $self->unsubscribe($name => $wrapper);
+ };
+ $self->on($name => $wrapper);
+ weaken $wrapper;
+ return $wrapper;
+}
+
+sub subscribers {
+ my ($self, $name) = @_;
+ $self->{events}->{error} ||= [sub { warn $_[1] }] if $name eq 'error';
+ return [@{$self->{events}->{$name} || []}];
+}
+
+sub unsubscribe {
+ my ($self, $name, $cb) = @_;
+ my $subscribers = $self->{events}->{$name} || [];
+ my @callbacks;
+ for my $subscriber (@$subscribers) {
+ next if $cb eq $subscriber;
+ push @callbacks, $subscriber;
+ }
+ $self->{events}->{$name} = \@callbacks;
+ return $self;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Mojo::IOLoop::EventEmitter - IOLoop Event Emitter
+
+=head1 SYNOPSIS
+
+ use Mojo::IOLoop::EventEmitter;
+
+ # Create new event emitter
+ my $e = Mojo::IOLoop::EventEmitter->new;
+
+ # Subscribe to events
+ $e->on(error => sub {
+ my ($self, $error) = @_;
+ warn "Catched: $error";
+ });
+ $e->on(test => sub {
+ my ($self, $message) = @_;
+ die "test: $message";
+ });
+
+ # Emit events
+ $e->emit(test => 'Hello!');
+
+=head1 DESCRIPTION
+
+L<Mojo::IOLoop::EventEmitter> is the event emitter used by L<Mojo::IOLoop>.
+Note that this module is EXPERIMENTAL and might change without warning!
+
+=head1 METHODS
+
+L<Mojo::IOLoop::EventEmitter> inherits all methods from L<Mojo::Base> and
+implements the following new ones.
+
+=head2 C<emit>
+
+ $e->emit('foo');
+ $e->emit('foo', 123);
+
+Emit event.
+
+=head2 C<on>
+
+ my $cb = $e->on(foo => sub {...});
+
+Subscribe to event.
+
+=head2 C<once>
+
+ my $cb = $e->once(foo => sub {...});
+
+Subscribe to event and unsubscribe again after it has been emitted once.
+
+=head2 C<subscribers>
+
+ my $subscribers = $e->subscribers('foo');
+
+All subscribers for event.
+
+=head2 C<unsubscribe>
+
+ $e->unsubscribe(foo => $cb);
+
+Unsubscribe from event.
+
+=head1 DEBUGGING
+
+You can set the C<MOJO_EVENTEMITTER_DEBUG> environment variable to get some
+advanced diagnostics information printed to C<STDERR>.
+
+ MOJO_EVENTEMITTER_DEBUG=1
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>.
+
+=cut
@@ -0,0 +1,432 @@
+package Mojo::IOLoop::Resolver;
+use Mojo::Base -base;
+
+use IO::File;
+use List::Util 'first';
+use Scalar::Util 'weaken';
+use Socket;
+
+use constant DEBUG => $ENV{MOJO_RESOLVER_DEBUG} || 0;
+
+# IPv6 DNS support requires "AF_INET6" and "inet_pton"
+use constant IPV6 => defined &Socket::AF_INET6 && defined &Socket::inet_pton;
+
+has ioloop => sub {
+ require Mojo::IOLoop;
+ Mojo::IOLoop->singleton;
+};
+has timeout => 3;
+
+# IPv4 regex (RFC 3986)
+my $DEC_OCTET_RE = qr/(?:[0-9]|[1-9][0-9]|1[0-9][0-9]|2[0-4][0-9]|25[0-5])/;
+our $IPV4_RE =
+ qr/^$DEC_OCTET_RE\.$DEC_OCTET_RE\.$DEC_OCTET_RE\.$DEC_OCTET_RE$/;
+
+# IPv6 regex (RFC 3986)
+my $H16_RE = qr/[0-9A-Fa-f]{1,4}/;
+my $LS32_RE = qr/(?:$H16_RE:$H16_RE|$IPV4_RE)/;
+our $IPV6_RE = qr/(?:
+ (?: $H16_RE : ){6} $LS32_RE
+ | :: (?: $H16_RE : ){5} $LS32_RE
+ | (?: $H16_RE )? :: (?: $H16_RE : ){4} $LS32_RE
+ | (?: (?: $H16_RE : ){0,1} $H16_RE )? :: (?: $H16_RE : ){3} $LS32_RE
+ | (?: (?: $H16_RE : ){0,2} $H16_RE )? :: (?: $H16_RE : ){2} $LS32_RE
+ | (?: (?: $H16_RE : ){0,3} $H16_RE )? :: $H16_RE : $LS32_RE
+ | (?: (?: $H16_RE : ){0,4} $H16_RE )? :: $LS32_RE
+ | (?: (?: $H16_RE : ){0,5} $H16_RE )? :: $H16_RE
+ | (?: (?: $H16_RE : ){0,6} $H16_RE )? ::
+)/x;
+
+# DNS server (default to Google Public DNS)
+my $SERVERS = ['8.8.8.8', '8.8.4.4'];
+
+# Try to detect DNS server
+if (-r '/etc/resolv.conf') {
+ my $file = IO::File->new('< /etc/resolv.conf');
+ my @servers;
+ for my $line (<$file>) {
+
+ # New DNS server
+ if ($line =~ /^nameserver\s+(\S+)$/) {
+ push @servers, $1;
+ warn qq/DETECTED DNS SERVER ($1)\n/ if DEBUG;
+ }
+ }
+ unshift @$SERVERS, @servers;
+}
+
+# User defined DNS server
+unshift @$SERVERS, $ENV{MOJO_DNS_SERVER} if $ENV{MOJO_DNS_SERVER};
+
+# Always start with first DNS server
+my $CURRENT_SERVER = 0;
+
+# DNS record types
+my $DNS_TYPES = {
+ '*' => 0x00ff,
+ A => 0x0001,
+ AAAA => 0x001c,
+ CNAME => 0x0005,
+ MX => 0x000f,
+ NS => 0x0002,
+ PTR => 0x000c,
+ TXT => 0x0010
+};
+
+# "localhost"
+our $LOCALHOST = '127.0.0.1';
+
+sub DESTROY { shift->_cleanup }
+
+sub is_ipv4 {
+ return 1 if $_[1] =~ $IPV4_RE;
+ return;
+}
+
+sub is_ipv6 {
+ return 1 if $_[1] =~ $IPV6_RE;
+ return;
+}
+
+sub lookup {
+ my ($self, $name, $cb) = @_;
+
+ # "localhost"
+ weaken $self;
+ return $self->ioloop->timer(0 => sub { $self->$cb($LOCALHOST) })
+ if $name eq 'localhost';
+
+ # IPv4
+ $self->resolve(
+ $name, 'A',
+ sub {
+ my ($self, $records) = @_;
+
+ # Success
+ my $result = first { $_->[0] eq 'A' } @$records;
+ return $self->$cb($result->[1]) if $result;
+
+ # IPv6
+ $self->resolve(
+ $name, 'AAAA',
+ sub {
+ my ($self, $records) = @_;
+
+ # Success
+ my $result = first { $_->[0] eq 'AAAA' } @$records;
+ return $self->$cb($result->[1]) if $result;
+
+ # Nothing
+ $self->$cb();
+ }
+ );
+ }
+ );
+}
+
+# "I can't believe it! Reading and writing actually paid off!"
+sub resolve {
+ my ($self, $name, $type, $cb) = @_;
+
+ # No lookup required or record type not supported
+ my $t = $DNS_TYPES->{$type};
+ my $v4 = $self->is_ipv4($name);
+ my $v6 = IPV6 ? $self->is_ipv6($name) : 0;
+ my $server = $self->servers;
+ my $loop = $self->ioloop;
+ weaken $self;
+ return $loop->timer(0 => sub { $self->$cb([]) })
+ if !$server || !$t || ($t ne $DNS_TYPES->{PTR} && ($v4 || $v6));
+
+ # Build request
+ warn "RESOLVE $type $name ($server)\n" if DEBUG;
+ my $tx;
+ do { $tx = int rand 0x10000 } while ($self->{requests}->{$tx});
+
+ # Header (one question with recursion)
+ my $req = pack 'nnnnnn', $tx, 0x0100, 1, 0, 0, 0;
+
+ # Reverse
+ my @parts = split /\./, $name;
+ if ($t eq $DNS_TYPES->{PTR}) {
+
+ # IPv4
+ if ($v4) { @parts = reverse 'arpa', 'in-addr', @parts }
+
+ # IPv6
+ elsif ($v6) {
+ @parts = reverse 'arpa', 'ip6', split //, unpack 'H32',
+ Socket::inet_pton(Socket::AF_INET6(), $name);
+ }
+ }
+
+ # Query (Internet)
+ for my $part (@parts) { $req .= pack 'C/a*', $part if defined $part }
+ $req .= pack 'Cnn', 0, $t, 0x0001;
+
+ # Send request
+ $self->_bind($server);
+ $self->{requests}->{$tx} = {
+ cb => $cb,
+ timer => $loop->timer(
+ $self->timeout => sub {
+ my $loop = shift;
+ warn "RESOLVE TIMEOUT ($server)\n" if DEBUG;
+ $CURRENT_SERVER++;
+ $self->_cleanup;
+ }
+ )
+ };
+ $loop->write($self->{id} => $req);
+}
+
+# "I wonder where Bart is, his dinner's getting all cold... and eaten."
+sub servers {
+ my $self = shift;
+
+ # New servers
+ if (@_) {
+ @$SERVERS = @_;
+ $CURRENT_SERVER = 0;
+ }
+
+ # List all
+ return @$SERVERS if wantarray;
+
+ # Current server
+ $CURRENT_SERVER = 0 unless $SERVERS->[$CURRENT_SERVER];
+ return $SERVERS->[$CURRENT_SERVER];
+}
+
+sub _bind {
+ my ($self, $server) = @_;
+
+ # Reuse socket
+ return if $self->{id};
+
+ # New socket
+ my $loop = $self->ioloop;
+ weaken $self;
+ $self->{id} = $loop->connect(
+ address => $server,
+ port => 53,
+ on_close => sub { $self->_cleanup },
+ on_error => sub {
+ my $loop = shift;
+ warn "RESOLVE FAILURE ($server)\n" if DEBUG;
+ $CURRENT_SERVER++;
+ $self->_cleanup;
+ },
+ on_read => sub {
+ my ($loop, $id, $chunk) = @_;
+
+ # Parse response
+ my @packet = unpack 'nnnnnna*', $chunk;
+ warn "ANSWERS $packet[3] ($server)\n" if DEBUG;
+ return unless my $r = delete $self->{requests}->{$packet[0]};
+
+ # Questions
+ my $content = $packet[6];
+ for (1 .. $packet[2]) {
+ my $n;
+ do { ($n, $content) = unpack 'C/aa*', $content } while ($n ne '');
+ $content = (unpack 'nna*', $content)[2];
+ }
+
+ # Answers
+ my @answers;
+ for (1 .. $packet[3]) {
+
+ # Parse
+ (my ($t, $ttl, $a), $content) =
+ (unpack 'nnnNn/aa*', $content)[1, 3, 4, 5];
+ my @answer = _parse_answer($t, $a, $chunk, $content);
+
+ # No answer
+ next unless @answer;
+
+ # Answer
+ push @answers, [@answer, $ttl];
+ warn "ANSWER $answer[0] $answer[1]\n" if DEBUG;
+ }
+ $loop->drop($r->{timer});
+ $r->{cb}->($self, \@answers);
+ },
+ args => {Proto => 'udp', Type => SOCK_DGRAM}
+ );
+}
+
+sub _cleanup {
+ my $self = shift;
+ return unless my $loop = $self->ioloop;
+ $loop->drop(delete $self->{id}) if $self->{id};
+ for my $tx (keys %{$self->{requests}}) {
+ my $r = delete $self->{requests}->{$tx};
+ $r->{cb}->($self, []);
+ }
+}
+
+sub _parse_answer {
+ my ($t, $a, $packet, $rest) = @_;
+
+ # A
+ if ($t eq $DNS_TYPES->{A}) { return A => join('.', unpack 'C4', $a) }
+
+ # AAAA
+ elsif ($t eq $DNS_TYPES->{AAAA}) {
+ return AAAA => sprintf('%x:%x:%x:%x:%x:%x:%x:%x', unpack('n*', $a));
+ }
+
+ # TXT
+ elsif ($t eq $DNS_TYPES->{TXT}) { return TXT => unpack('(C/a*)*', $a) }
+
+ # Offset
+ my $offset = length($packet) - length($rest) - length($a);
+
+ # CNAME
+ my $type;
+ if ($t eq $DNS_TYPES->{CNAME}) { $type = 'CNAME' }
+
+ # MX
+ elsif ($t eq $DNS_TYPES->{MX}) {
+ $type = 'MX';
+ $offset += 2;
+ }
+
+ # NS
+ elsif ($t eq $DNS_TYPES->{NS}) { $type = 'NS' }
+
+ # PTR
+ elsif ($t eq $DNS_TYPES->{PTR}) { $type = 'PTR' }
+
+ # Domain name
+ return $type => _parse_name($packet, $offset) if $type;
+
+ # Not supported
+ return;
+}
+
+sub _parse_name {
+ my ($packet, $offset) = @_;
+
+ # Elements
+ my @elements;
+ for (1 .. 128) {
+
+ # Element length
+ my $len = ord substr $packet, $offset++, 1;
+
+ # Offset
+ if ($len >= 0xc0) {
+ $offset = (unpack 'n', substr $packet, ++$offset - 2, 2) & 0x3fff;
+ }
+
+ # Element
+ elsif ($len) {
+ push @elements, substr $packet, $offset, $len;
+ $offset += $len;
+ }
+
+ # Zero length element (the end)
+ else { return join '.', @elements }
+ }
+
+ return;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Mojo::IOLoop::Resolver - IOLoop DNS Stub Resolver
+
+=head1 SYNOPSIS
+
+ use Mojo::IOLoop::Resolver;
+
+=head1 DESCRIPTION
+
+L<Mojo::IOLoop::Resolver> is a minimalistic async I/O DNS stub resolver used
+by L<Mojo:IOLoop>.
+Note that this module is EXPERIMENTAL and might change without warning!
+
+=head1 ATTRIBUTES
+
+L<Mojo::IOLoop::Resolver> implements the following attributes.
+
+=head2 C<ioloop>
+
+ my $ioloop = $resolver->ioloop;
+ $resolver = $resolver->ioloop(Mojo::IOLoop->new);
+
+Loop object to use for I/O operations, defaults to a L<Mojo::IOLoop> object.
+
+=head2 C<timeout>
+
+ my $timeout = $resolver->timeout;
+ $resolver = $resolver->timeout(5);
+
+Maximum time in seconds a C<DNS> lookup can take, defaults to C<3>.
+
+=head1 METHODS
+
+L<Mojo::IOLoop::Resolver> inherits all methods from L<Mojo::Base> and
+implements the following new ones.
+
+=head2 C<is_ipv4>
+
+ my $is_ipv4 = $resolver->is_ipv4('127.0.0.1');
+
+Check if value is a valid C<IPv4> address.
+
+=head2 C<is_ipv6>
+
+ my $is_ipv6 = $resolver->is_ipv6('::1');
+
+Check if value is a valid C<IPv6> address.
+
+=head2 C<lookup>
+
+ $resolver->lookup('mojolicio.us' => sub {...});
+
+Lookup C<IPv4> or C<IPv6> address for domain.
+
+ $resolver->lookup('mojolicio.us' => sub {
+ my ($loop, $address) = @_;
+ print "Address: $address\n";
+ Mojo::IOLoop->stop;
+ });
+ Mojo::IOLoop->start;
+
+=head2 C<resolve>
+
+ $resolver->resolve('mojolicio.us', 'A', sub {...});
+
+Resolve domain into C<A>, C<AAAA>, C<CNAME>, C<MX>, C<NS>, C<PTR> or C<TXT>
+records, C<*> will query for all at once.
+Since this is a "stub resolver" it depends on a recursive name server for DNS
+resolution.
+
+=head2 C<servers>
+
+ my @all = $resolver->servers;
+ my $current = $resolver->servers;
+ $resolver->servers('8.8.8.8', '8.8.4.4');
+
+IP addresses of C<DNS> servers used for lookups, defaults to the value of
+the C<MOJO_DNS_SERVER> environment variable, auto detection, C<8.8.8.8> or
+C<8.8.4.4>.
+
+=head1 DEBUGGING
+
+You can set the C<MOJO_RESOLVER_DEBUG> environment variable to get some
+advanced diagnostics information printed to C<STDERR>.
+
+ MOJO_RESOLVER_DEBUG=1
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>.
+
+=cut
@@ -0,0 +1,376 @@
+package Mojo::IOLoop::Server;
+use Mojo::Base 'Mojo::IOLoop::EventEmitter';
+
+use Carp 'croak';
+use File::Spec;
+use IO::File;
+use IO::Socket::INET;
+use Scalar::Util 'weaken';
+use Socket qw/IPPROTO_TCP TCP_NODELAY/;
+
+# IPv6 support requires IO::Socket::IP
+use constant IPV6 => $ENV{MOJO_NO_IPV6}
+ ? 0
+ : eval 'use IO::Socket::IP 0.06 (); 1';
+
+# TLS support requires IO::Socket::SSL
+use constant TLS => $ENV{MOJO_NO_TLS}
+ ? 0
+ : eval 'use IO::Socket::SSL 1.43 "inet4"; 1';
+use constant TLS_READ => TLS ? IO::Socket::SSL::SSL_WANT_READ() : 0;
+use constant TLS_WRITE => TLS ? IO::Socket::SSL::SSL_WANT_WRITE() : 0;
+
+# Default TLS cert (20.03.2010)
+# (openssl req -new -x509 -keyout cakey.pem -out cacert.pem -nodes -days 7300)
+use constant CERT => <<EOF;
+-----BEGIN CERTIFICATE-----
+MIIDbzCCAtigAwIBAgIJAM+kFv1MwalmMA0GCSqGSIb3DQEBBQUAMIGCMQswCQYD
+VQQGEwJERTEWMBQGA1UECBMNTmllZGVyc2FjaHNlbjESMBAGA1UEBxMJSGFtYmVy
+Z2VuMRQwEgYDVQQKEwtNb2pvbGljaW91czESMBAGA1UEAxMJbG9jYWxob3N0MR0w
+GwYJKoZIhvcNAQkBFg5rcmFpaEBjcGFuLm9yZzAeFw0xMDAzMjAwMDQ1MDFaFw0z
+MDAzMTUwMDQ1MDFaMIGCMQswCQYDVQQGEwJERTEWMBQGA1UECBMNTmllZGVyc2Fj
+aHNlbjESMBAGA1UEBxMJSGFtYmVyZ2VuMRQwEgYDVQQKEwtNb2pvbGljaW91czES
+MBAGA1UEAxMJbG9jYWxob3N0MR0wGwYJKoZIhvcNAQkBFg5rcmFpaEBjcGFuLm9y
+ZzCBnzANBgkqhkiG9w0BAQEFAAOBjQAwgYkCgYEAzu9mOiyUJB2NBuf1lZxViNM2
+VISqRAoaXXGOBa6RgUoVfA/n81RQlgvVA0qCSQHC534DdYRk3CdyJR9UGPuxF8k4
+CckOaHWgcJJsd8H0/q73PjbA5ItIpGTTJNh8WVpFDjHTJmQ5ihwddap4/offJxZD
+dPrMFtw1ZHBRug5tHUECAwEAAaOB6jCB5zAdBgNVHQ4EFgQUo+Re5wuuzVFqH/zV
+cxRGXL0j5K4wgbcGA1UdIwSBrzCBrIAUo+Re5wuuzVFqH/zVcxRGXL0j5K6hgYik
+gYUwgYIxCzAJBgNVBAYTAkRFMRYwFAYDVQQIEw1OaWVkZXJzYWNoc2VuMRIwEAYD
+VQQHEwlIYW1iZXJnZW4xFDASBgNVBAoTC01vam9saWNpb3VzMRIwEAYDVQQDEwls
+b2NhbGhvc3QxHTAbBgkqhkiG9w0BCQEWDmtyYWloQGNwYW4ub3JnggkAz6QW/UzB
+qWYwDAYDVR0TBAUwAwEB/zANBgkqhkiG9w0BAQUFAAOBgQCZZcOeAobctD9wtPtO
+40CKHpiGYEM3rh7VvBhjTcVnX6XlLvffIg3uTrVRhzmlEQCZz3O5TsBzfMAVnjYz
+llhwgRF6Xn8ict9L8yKDoGSbw0Q7HaCb8/kOe0uKhcSDUd3PjJU0ZWgc20zcGFA9
+R65bABoJ2vU1rlQFmjs0RT4UcQ==
+-----END CERTIFICATE-----
+EOF
+
+# Default TLS key (20.03.2010)
+# (openssl req -new -x509 -keyout cakey.pem -out cacert.pem -nodes -days 7300)
+use constant KEY => <<EOF;
+-----BEGIN RSA PRIVATE KEY-----
+MIICXAIBAAKBgQDO72Y6LJQkHY0G5/WVnFWI0zZUhKpEChpdcY4FrpGBShV8D+fz
+VFCWC9UDSoJJAcLnfgN1hGTcJ3IlH1QY+7EXyTgJyQ5odaBwkmx3wfT+rvc+NsDk
+i0ikZNMk2HxZWkUOMdMmZDmKHB11qnj+h98nFkN0+swW3DVkcFG6Dm0dQQIDAQAB
+AoGAeLmd8C51tqQu1GqbEc+E7zAZsDE9jDhArWdELfhsFvt7kUdOUN1Nrlv0x9i+
+LY2Dgb44kmTM2suAgjvGulSMOYBGosZcM0w3ES76nmeAVJ1NBFhbZTCJqo9svoD/
+NKdctRflUuvFSWimoui+vj9D5p/4lvAMdBHUWj5FlQsYiOECQQD/FRXtsDetptFu
+Vp8Kw+6bZ5+efcjVfciTp7fQKI2xZ2n1QyloaV4zYXgDC2y3fMYuRigCGrX9XeFX
+oGHGMyYFAkEAz635I8f4WQa/wvyl/SR5agtDVnkJqMHMgOuykytiF8NFbDSkJv+b
+1VfyrWcfK/PVsSGBI67LCMDoP+PZBVOjDQJBAIInoCjH4aEZnYNPb5duojFpjmiw
+helpZQ7yZTgxeRssSUR8IITGPuq4sSPckHyPjg/OfFuWhYXigTjU/Q7EyoECQERT
+Dykna9wWLVZ/+jgLHOq3Y+L6FSRxBc/QO0LRvgblVlygAPVXmLQaqBtGVuoF4WLS
+DANqSR/LH12Nn2NyPa0CQBbzoHgx2i3RncWoq1EeIg2mSMevEcjA6sxgYmsyyzlv
+AnqxHi90n/p912ynLg2SjBq+03GaECeGzC/QqKK2gtA=
+-----END RSA PRIVATE KEY-----
+EOF
+
+has iowatcher => sub {
+ require Mojo::IOLoop;
+ Mojo::IOLoop->singleton->iowatcher;
+};
+
+sub DESTROY {
+ my $self = shift;
+ if (my $cert = $self->{cert}) { unlink $cert if -w $cert }
+ if (my $key = $self->{key}) { unlink $key if -w $key }
+ return unless my $watcher = $self->iowatcher;
+ $self->pause if $self->{handle};
+ $watcher->remove($_) for values %{$self->{handles}};
+}
+
+# "Have you ever seen that Blue Man Group? Total ripoff of the Smurfs.
+# And the Smurfs, well, they SUCK."
+sub listen {
+ my $self = shift;
+ my $args = ref $_[0] ? $_[0] : {@_};
+
+ # Look for reusable file descriptor
+ my $reuse = my $port = $args->{port} || 3000;
+ $ENV{MOJO_REUSE} ||= '';
+ my $fd;
+ if ($ENV{MOJO_REUSE} =~ /(?:^|\,)$reuse\:(\d+)/) { $fd = $1 }
+
+ # Allow file descriptor inheritance
+ local $^F = 1000;
+
+ # Reuse file descriptor
+ my $handle;
+ my $class = IPV6 ? 'IO::Socket::IP' : 'IO::Socket::INET';
+ if (defined $fd) {
+ $handle = $class->new;
+ $handle->fdopen($fd, 'r')
+ or croak "Can't open file descriptor $fd: $!";
+ }
+
+ # New socket
+ else {
+ my %options = (
+ Listen => $args->{backlog} || SOMAXCONN,
+ LocalAddr => $args->{address} || '0.0.0.0',
+ LocalPort => $port,
+ Proto => 'tcp',
+ ReuseAddr => 1,
+ Type => SOCK_STREAM,
+ %{$args->{args} || {}}
+ );
+ $options{LocalAddr} =~ s/[\[\]]//g;
+ $handle = $class->new(%options)
+ or croak "Can't create listen socket: $!";
+ $fd = fileno $handle;
+ $reuse = ",$reuse" if length $ENV{MOJO_REUSE};
+ $ENV{MOJO_REUSE} .= "$reuse:$fd";
+ }
+ $self->{handle} = $handle;
+
+ # TLS
+ if ($args->{tls}) {
+
+ # No TLS support
+ croak "IO::Socket::SSL 1.43 required for TLS support" unless TLS;
+
+ # Options
+ my %options = (
+ SSL_startHandshake => 0,
+ SSL_cert_file => $args->{tls_cert} || $self->_cert_file,
+ SSL_key_file => $args->{tls_key} || $self->_key_file,
+ );
+ %options = (
+ SSL_verify_callback => $args->{tls_verify},
+ SSL_ca_file => -T $args->{tls_ca} ? $args->{tls_ca} : undef,
+ SSL_ca_path => -d $args->{tls_ca} ? $args->{tls_ca} : undef,
+ SSL_verify_mode => $args->{tls_ca} ? 0x03 : undef,
+ %options
+ ) if $args->{tls_ca};
+ $self->{tls} = {%options, %{$args->{tls_args} || {}}};
+ }
+}
+
+sub generate_port {
+
+ # Try random ports
+ my $port = 1 . int(rand 10) . int(rand 10) . int(rand 10) . int(rand 10);
+ while ($port++ < 30000) {
+ return $port
+ if IO::Socket::INET->new(
+ Listen => 5,
+ LocalAddr => '127.0.0.1',
+ LocalPort => $port,
+ Proto => 'tcp'
+ );
+ }
+
+ return;
+}
+
+sub pause {
+ my $self = shift;
+ $self->iowatcher->remove($self->{handle});
+}
+
+sub resume {
+ my $self = shift;
+ weaken $self;
+ $self->iowatcher->add($self->{handle},
+ on_readable => sub { $self->_accept });
+}
+
+sub _accept {
+ my $self = shift;
+
+ # Accept
+ my $handle = $self->{handle}->accept;
+ return $self->emit(accept => $handle) unless my $tls = $self->{tls};
+
+ # Start TLS handshake
+ weaken $self;
+ $tls->{SSL_error_trap} = sub {
+ my $handle = delete $self->{handles}->{$handle};
+ $self->iowatcher->remove($handle);
+ close $handle;
+ };
+ $handle = IO::Socket::SSL->start_SSL($handle, %$tls);
+ $self->iowatcher->add(
+ $handle,
+ on_readable => sub { $self->_tls($handle) },
+ on_writable => sub { $self->_tls($handle) }
+ );
+ $self->{handles}->{$handle} = $handle;
+
+ # Non-blocking
+ $handle->blocking(0);
+
+ # Disable Nagle's algorithm
+ setsockopt($handle, IPPROTO_TCP, TCP_NODELAY, 1) unless $self->{file};
+}
+
+sub _cert_file {
+ my $self = shift;
+
+ # Check if temporary TLS cert file already exists
+ my $cert = $self->{cert};
+ return $cert if $cert && -r $cert;
+
+ # Create temporary TLS cert file
+ $cert = File::Spec->catfile($ENV{MOJO_TMPDIR} || File::Spec->tmpdir,
+ 'mojocert.pem');
+ croak qq/Can't create temporary TLS cert file "$cert"/
+ unless my $file = IO::File->new("> $cert");
+ print $file CERT;
+
+ $self->{cert} = $cert;
+}
+
+sub _key_file {
+ my $self = shift;
+
+ # Check if temporary TLS key file already exists
+ my $key = $self->{key};
+ return $key if $key && -r $key;
+
+ # Create temporary TLS key file
+ $key = File::Spec->catfile($ENV{MOJO_TMPDIR} || File::Spec->tmpdir,
+ 'mojokey.pem');
+ croak qq/Can't create temporary TLS key file "$key"/
+ unless my $file = IO::File->new("> $key");
+ print $file KEY;
+
+ $self->{key} = $key;
+}
+
+sub _tls {
+ my ($self, $handle) = @_;
+
+ # Accept
+ if ($handle->accept_SSL) {
+ $self->iowatcher->remove($handle);
+ delete $self->{handles}->{$handle};
+ return $self->emit(accept => $handle);
+ }
+
+ # Switch between reading and writing
+ my $error = $IO::Socket::SSL::SSL_ERROR;
+ if ($error == TLS_READ) { $self->iowatcher->not_writing($handle) }
+ elsif ($error == TLS_WRITE) { $self->iowatcher->writing($handle) }
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Mojo::IOLoop::Server - IOLoop Socket Server
+
+=head1 SYNOPSIS
+
+ use Mojo::IOLoop::Server;
+
+ # Create listen socket
+ my $server = Mojo::IOLoop::Server->new;
+ $server->on(accept => sub {
+ my ($self, $handle) = @_;
+ ...
+ });
+ $server->listen(port => 3000);
+
+ # Start and stop accepting connections
+ $server->resume;
+ $server->pause;
+
+=head1 DESCRIPTION
+
+L<Mojo::IOLoop::Server> accepts incoming socket connections for
+L<Mojo::IOLoop>.
+Note that this module is EXPERIMENTAL and might change without warning!
+
+=head1 ATTRIBUTES
+
+L<Mojo::IOLoop::Server> implements the following attributes.
+
+=head2 C<iowatcher>
+
+ my $watcher = $server->iowatcher;
+ $server = $server->iowatcher(Mojo::IOWatcher->new);
+
+Low level event watcher, usually a L<Mojo::IOWatcher> or
+L<Mojo::IOWatcher::EV> object.
+
+=head1 METHODS
+
+L<Mojo::IOLoop::Server> inherits all methods from
+L<Mojo::IOLoop::EventEmitter> and implements the following new ones.
+
+=head2 C<listen>
+
+ $server->listen(port => 3000);
+
+Create a new listen socket.
+Note that TLS support depends on L<IO::Socket::SSL> and IPv6 support on
+L<IO::Socket::IP>.
+
+These options are currently available:
+
+=over 2
+
+=item C<address>
+
+Local address to listen on, defaults to all.
+
+=item C<backlog>
+
+Maximum backlog size, defaults to C<SOMAXCONN>.
+
+=item C<port>
+
+Port to listen on.
+
+=item C<tls>
+
+Enable TLS.
+
+=item C<tls_cert>
+
+Path to the TLS cert file, defaulting to a built-in test certificate.
+
+=item C<tls_key>
+
+Path to the TLS key file, defaulting to a built-in test key.
+
+=item C<tls_ca>
+
+Path to TLS certificate authority file or directory.
+
+=back
+
+=head2 C<generate_port>
+
+ my $port = $server->generate_port;
+
+Find a free TCP port.
+
+=head2 C<pause>
+
+ $server->pause;
+
+Stop accepting connections.
+
+=head2 C<resume>
+
+ $server->resume;
+
+Start accepting connections.
+
+=head1 EVENTS
+
+L<Mojo::IOLoop::Server> can emit the following events.
+
+=head2 C<accept>
+
+Emitted for each accepted connection.
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>.
+
+=cut
@@ -0,0 +1,271 @@
+package Mojo::IOLoop::Stream;
+use Mojo::Base 'Mojo::IOLoop::EventEmitter';
+
+use Errno qw/EAGAIN EINTR ECONNRESET EWOULDBLOCK/;
+use Scalar::Util 'weaken';
+
+use constant CHUNK_SIZE => $ENV{MOJO_CHUNK_SIZE} || 131072;
+
+# Windows
+use constant WINDOWS => $^O eq 'MSWin32' || $^O =~ /cygwin/ ? 1 : 0;
+
+has iowatcher => sub {
+ require Mojo::IOLoop;
+ Mojo::IOLoop->singleton->iowatcher;
+};
+
+sub DESTROY {
+ my $self = shift;
+ $self->pause;
+ $self->emit('close') if $self->{handle};
+}
+
+# "And America has so many enemies.
+# Iran, Iraq, China, Mordor, the hoochies that laid low Tiger Woods,
+# undesirable immigrants - by which I mean everyone that came after me,
+# including my children..."
+sub new {
+ my $self = shift->SUPER::new;
+ $self->{handle} = shift;
+ $self->{handle}->blocking(0);
+ $self->{buffer} = '';
+ return $self;
+}
+
+sub handle { shift->{handle} }
+
+sub is_finished {
+ my $self = shift;
+ return if length $self->{buffer};
+ return if @{$self->subscribers('drain')};
+ return 1;
+}
+
+sub pause {
+ my $self = shift;
+ return unless my $handle = $self->{handle};
+ return unless my $watcher = $self->iowatcher;
+ $watcher->remove($handle);
+}
+
+sub resume {
+ my $self = shift;
+ weaken $self;
+ $self->iowatcher->add(
+ $self->{handle},
+ on_readable => sub { $self->_read },
+ on_writable => sub { $self->_write }
+ );
+}
+
+sub steal_handle {
+ my $self = shift;
+ $self->pause;
+ return delete $self->{handle};
+}
+
+sub write {
+ my ($self, $chunk, $cb) = @_;
+
+ # Prepare chunk for writing
+ $self->{buffer} .= $chunk;
+
+ # UNIX only quick write
+ unless (WINDOWS) {
+ local $self->{quick} = 1 if $cb;
+ $self->_write;
+ }
+
+ # Write with roundtrip
+ if ($cb) { $self->once(drain => $cb) }
+ else { return unless length $self->{buffer} }
+
+ # Start writing
+ return unless my $handle = $self->{handle};
+ $self->iowatcher->writing($handle);
+}
+
+sub _read {
+ my $self = shift;
+
+ # Read
+ my $read = $self->{handle}->sysread(my $buffer, CHUNK_SIZE, 0);
+
+ # Error
+ unless (defined $read) {
+
+ # Retry
+ return if $! == EAGAIN || $! == EINTR || $! == EWOULDBLOCK;
+
+ # Connection reset
+ return $self->emit('close') if $! == ECONNRESET;
+
+ # Read error
+ return $self->emit(error => $!);
+ }
+
+ # EOF
+ return $self->emit('close') if $read == 0;
+
+ # Handle read
+ $self->emit(read => $buffer);
+}
+
+sub _write {
+ my $self = shift;
+
+ # Handle drain
+ $self->emit('drain') if !length $self->{buffer} && !$self->{quick};
+
+ # Write as much as possible
+ my $handle = $self->{handle};
+ if (length $self->{buffer}) {
+ my $written = $handle->syswrite($self->{buffer});
+
+ # Error
+ unless (defined $written) {
+
+ # Retry
+ return if $! == EAGAIN || $! == EINTR || $! == EWOULDBLOCK;
+
+ # Close
+ return $self->emit('close')
+ if $handle->can('connected') && !$handle->connected;
+
+ # Write error
+ return $self->emit(error => $!);
+ }
+
+ # Remove written chunk from buffer
+ substr $self->{buffer}, 0, $written, '';
+ }
+
+ # Stop writing
+ return
+ if length $self->{buffer}
+ || $self->{quick}
+ || @{$self->subscribers('drain')};
+ $self->iowatcher->not_writing($handle);
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Mojo::IOLoop::Stream - IOLoop Stream
+
+=head1 SYNOPSIS
+
+ use Mojo::IOLoop::Stream;
+
+ # Create stream
+ my $stream = Mojo::IOLoop::Stream->new($handle);
+ $stream->on(read => sub {
+ my ($self, $chunk) = @_;
+ ...
+ });
+ $stream->on(close => sub {
+ my $self = shift;
+ ...
+ });
+ $stream->on(error => sub {
+ my ($self, $error) = @_;
+ ...
+ });
+
+ # Start and stop watching for new data
+ $stream->resume;
+ $stream->pause;
+
+=head1 DESCRIPTION
+
+L<Mojo::IOLoop::Stream> is a container for streaming handles used by
+L<Mojo::IOLoop>.
+Note that this module is EXPERIMENTAL and might change without warning!
+
+=head1 ATTRIBUTES
+
+L<Mojo::IOLoop::Stream> implements the following attributes.
+
+=head2 C<iowatcher>
+
+ my $watcher = $stream->iowatcher;
+ $stream = $stream->iowatcher(Mojo::IOWatcher->new);
+
+Low level event watcher, usually a L<Mojo::IOWatcher> or
+L<Mojo::IOWatcher::EV> object.
+
+=head1 METHODS
+
+L<Mojo::IOLoop::Stream> inherits all methods from
+L<Mojo::IOLoop::EventEmitter> and implements the following new ones.
+
+=head2 C<new>
+
+ my $stream = Mojo::IOLoop::Stream->new($handle);
+
+Construct a new L<Mojo::IOLoop::Stream> object.
+
+=head2 C<handle>
+
+ my $handle = $stream->handle;
+
+Get handle for stream.
+
+=head2 C<is_finished>
+
+ my $finished = $stream->is_finished;
+
+Check if stream is in a state where it is safe to close or steal the handle.
+
+=head2 C<pause>
+
+ $stream->pause;
+
+Stop watching for new data on the stream.
+
+=head2 C<resume>
+
+ $stream->resume;
+
+Start watching for new data on the stream.
+
+=head2 C<steal_handle>
+
+ my $handle = $stream->steal_handle;
+
+Steal handle from stream and prevent it from getting closed automatically.
+
+=head2 C<write>
+
+ $stream->write('Hello!');
+
+Write data to stream, the optional drain callback will be invoked once all
+data has been written.
+
+=head1 EVENTS
+
+L<Mojo::IOLoop::Stream> can emit the following events.
+
+=head2 C<close>
+
+Emitted if the stream gets closed.
+
+=head2 C<drain>
+
+Emitted once all data has been written.
+
+=head2 C<error>
+
+Emitted if an error happens on the stream.
+
+=head2 C<read>
+
+Emitted if new data arrives on the stream.
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>.
+
+=cut
@@ -1,110 +1,22 @@
package Mojo::IOLoop;
use Mojo::Base -base;
-use Carp 'croak';
-use Errno qw/EAGAIN EINTR ECONNRESET EWOULDBLOCK/;
-use File::Spec;
-use IO::File;
-use IO::Socket::INET;
-use IO::Socket::UNIX;
+use Mojo::IOLoop::Client;
+use Mojo::IOLoop::Resolver;
+use Mojo::IOLoop::Server;
+use Mojo::IOLoop::Stream;
use Mojo::IOWatcher;
-use Mojo::Resolver;
use Scalar::Util 'weaken';
-use Socket qw/IPPROTO_TCP TCP_NODELAY/;
use Time::HiRes 'time';
-use constant DEBUG => $ENV{MOJO_IOLOOP_DEBUG} || 0;
-use constant CHUNK_SIZE => $ENV{MOJO_CHUNK_SIZE} || 131072;
-
-# IPv6 support requires IO::Socket::IP
-use constant IPV6 => $ENV{MOJO_NO_IPV6}
- ? 0
- : eval 'use IO::Socket::IP 0.06 (); 1';
-
-# Epoll support requires IO::Epoll
-use constant EPOLL => $ENV{MOJO_POLL}
- ? 0
- : eval 'use Mojo::IOWatcher::Epoll; 1';
-
-# KQueue support requires IO::KQueue
-use constant KQUEUE => $ENV{MOJO_POLL}
- ? 0
- : eval 'use Mojo::IOWatcher::KQueue; 1';
-
-# TLS support requires IO::Socket::SSL
-use constant TLS => $ENV{MOJO_NO_TLS}
- ? 0
- : eval 'use IO::Socket::SSL 1.43 "inet4"; 1';
-use constant TLS_READ => TLS ? IO::Socket::SSL::SSL_WANT_READ() : 0;
-use constant TLS_WRITE => TLS ? IO::Socket::SSL::SSL_WANT_WRITE() : 0;
-
-# Windows
-use constant WINDOWS => $^O eq 'MSWin32' || $^O =~ /cygwin/ ? 1 : 0;
-
-# Default TLS cert (20.03.2010)
-# (openssl req -new -x509 -keyout cakey.pem -out cacert.pem -nodes -days 7300)
-use constant CERT => <<EOF;
------BEGIN CERTIFICATE-----
-MIIDbzCCAtigAwIBAgIJAM+kFv1MwalmMA0GCSqGSIb3DQEBBQUAMIGCMQswCQYD
-VQQGEwJERTEWMBQGA1UECBMNTmllZGVyc2FjaHNlbjESMBAGA1UEBxMJSGFtYmVy
-Z2VuMRQwEgYDVQQKEwtNb2pvbGljaW91czESMBAGA1UEAxMJbG9jYWxob3N0MR0w
-GwYJKoZIhvcNAQkBFg5rcmFpaEBjcGFuLm9yZzAeFw0xMDAzMjAwMDQ1MDFaFw0z
-MDAzMTUwMDQ1MDFaMIGCMQswCQYDVQQGEwJERTEWMBQGA1UECBMNTmllZGVyc2Fj
-aHNlbjESMBAGA1UEBxMJSGFtYmVyZ2VuMRQwEgYDVQQKEwtNb2pvbGljaW91czES
-MBAGA1UEAxMJbG9jYWxob3N0MR0wGwYJKoZIhvcNAQkBFg5rcmFpaEBjcGFuLm9y
-ZzCBnzANBgkqhkiG9w0BAQEFAAOBjQAwgYkCgYEAzu9mOiyUJB2NBuf1lZxViNM2
-VISqRAoaXXGOBa6RgUoVfA/n81RQlgvVA0qCSQHC534DdYRk3CdyJR9UGPuxF8k4
-CckOaHWgcJJsd8H0/q73PjbA5ItIpGTTJNh8WVpFDjHTJmQ5ihwddap4/offJxZD
-dPrMFtw1ZHBRug5tHUECAwEAAaOB6jCB5zAdBgNVHQ4EFgQUo+Re5wuuzVFqH/zV
-cxRGXL0j5K4wgbcGA1UdIwSBrzCBrIAUo+Re5wuuzVFqH/zVcxRGXL0j5K6hgYik
-gYUwgYIxCzAJBgNVBAYTAkRFMRYwFAYDVQQIEw1OaWVkZXJzYWNoc2VuMRIwEAYD
-VQQHEwlIYW1iZXJnZW4xFDASBgNVBAoTC01vam9saWNpb3VzMRIwEAYDVQQDEwls
-b2NhbGhvc3QxHTAbBgkqhkiG9w0BCQEWDmtyYWloQGNwYW4ub3JnggkAz6QW/UzB
-qWYwDAYDVR0TBAUwAwEB/zANBgkqhkiG9w0BAQUFAAOBgQCZZcOeAobctD9wtPtO
-40CKHpiGYEM3rh7VvBhjTcVnX6XlLvffIg3uTrVRhzmlEQCZz3O5TsBzfMAVnjYz
-llhwgRF6Xn8ict9L8yKDoGSbw0Q7HaCb8/kOe0uKhcSDUd3PjJU0ZWgc20zcGFA9
-R65bABoJ2vU1rlQFmjs0RT4UcQ==
------END CERTIFICATE-----
-EOF
-
-# Default TLS key (20.03.2010)
-# (openssl req -new -x509 -keyout cakey.pem -out cacert.pem -nodes -days 7300)
-use constant KEY => <<EOF;
------BEGIN RSA PRIVATE KEY-----
-MIICXAIBAAKBgQDO72Y6LJQkHY0G5/WVnFWI0zZUhKpEChpdcY4FrpGBShV8D+fz
-VFCWC9UDSoJJAcLnfgN1hGTcJ3IlH1QY+7EXyTgJyQ5odaBwkmx3wfT+rvc+NsDk
-i0ikZNMk2HxZWkUOMdMmZDmKHB11qnj+h98nFkN0+swW3DVkcFG6Dm0dQQIDAQAB
-AoGAeLmd8C51tqQu1GqbEc+E7zAZsDE9jDhArWdELfhsFvt7kUdOUN1Nrlv0x9i+
-LY2Dgb44kmTM2suAgjvGulSMOYBGosZcM0w3ES76nmeAVJ1NBFhbZTCJqo9svoD/
-NKdctRflUuvFSWimoui+vj9D5p/4lvAMdBHUWj5FlQsYiOECQQD/FRXtsDetptFu
-Vp8Kw+6bZ5+efcjVfciTp7fQKI2xZ2n1QyloaV4zYXgDC2y3fMYuRigCGrX9XeFX
-oGHGMyYFAkEAz635I8f4WQa/wvyl/SR5agtDVnkJqMHMgOuykytiF8NFbDSkJv+b
-1VfyrWcfK/PVsSGBI67LCMDoP+PZBVOjDQJBAIInoCjH4aEZnYNPb5duojFpjmiw
-helpZQ7yZTgxeRssSUR8IITGPuq4sSPckHyPjg/OfFuWhYXigTjU/Q7EyoECQERT
-Dykna9wWLVZ/+jgLHOq3Y+L6FSRxBc/QO0LRvgblVlygAPVXmLQaqBtGVuoF4WLS
-DANqSR/LH12Nn2NyPa0CQBbzoHgx2i3RncWoq1EeIg2mSMevEcjA6sxgYmsyyzlv
-AnqxHi90n/p912ynLg2SjBq+03GaECeGzC/QqKK2gtA=
------END RSA PRIVATE KEY-----
-EOF
-
-has [qw/accept_timeout connect_timeout/] => 3;
-has iowatcher => sub {
-
- # "kqueue"
- if (KQUEUE) {
- warn "KQUEUE MAINLOOP\n" if DEBUG;
- return Mojo::IOWatcher::KQueue->new;
- }
-
- # "epoll"
- if (EPOLL) {
- warn "EPOLL MAINLOOP\n" if DEBUG;
- return Mojo::IOWatcher::Epoll->new;
- }
+use constant DEBUG => $ENV{MOJO_IOLOOP_DEBUG} || 0;
- # "poll"
- warn "POLL MAINLOOP\n" if DEBUG;
- Mojo::IOWatcher->new;
+has client_class => 'Mojo::IOLoop::Client';
+has connect_timeout => 3;
+has iowatcher => sub {
+ my $class = Mojo::IOWatcher->detect;
+ warn "MAINLOOP ($class)\n" if DEBUG;
+ $class->new;
};
has max_accepts => 0;
has max_connections => 1000;
@@ -112,21 +24,17 @@ has [qw/on_lock on_unlock/] => sub {
sub {1}
};
has resolver => sub {
- my $self = shift;
- weaken $self;
- Mojo::Resolver->new(ioloop => $self);
+ my $resolver = Mojo::IOLoop::Resolver->new(ioloop => shift);
+ weaken $resolver->{ioloop};
+ return $resolver;
};
-has timeout => '0.025';
+has server_class => 'Mojo::IOLoop::Server';
+has stream_class => 'Mojo::IOLoop::Stream';
+has timeout => '0.025';
# Singleton
our $LOOP;
-sub DESTROY {
- my $self = shift;
- if (my $cert = $self->{cert}) { unlink $cert if -w $cert }
- if (my $key = $self->{key}) { unlink $key if -w $key }
-}
-
sub new {
my $class = shift;
@@ -152,78 +60,96 @@ sub connect {
my $self = shift;
$self = $self->singleton unless ref $self;
my $args = ref $_[0] ? $_[0] : {@_};
- $args->{proto} ||= 'tcp';
-
- # New connection
- my $c = {
- buffer => '',
- on_connect => $args->{on_connect},
- connecting => 1,
- tls => $args->{tls},
- tls_cert => $args->{tls_cert},
- tls_key => $args->{tls_key}
- };
- (my $id) = "$c" =~ /0x([\da-f]+)/;
- $self->{cs}->{$id} = $c;
-
- # Register callbacks
- for my $name (qw/close error read/) {
- my $cb = $args->{"on_$name"};
- my $event = "on_$name";
- $self->$event($id => $cb) if $cb;
- }
- # Lookup
- if (!$args->{handle} && (my $address = $args->{address})) {
- weaken $self;
- $self->resolver->lookup(
- $address => sub {
- my $resolver = shift;
- $args->{address} = shift || $args->{address};
- $self->_connect($id, $args);
- }
- );
- }
+ # New client
+ my $client = $self->client_class->new;
+ (my $id) = "$client" =~ /0x([\da-f]+)/;
+ $id = $args->{id} if $args->{id};
+ my $c = $self->{connections}->{$id} ||= {};
+ $c->{client} = $client;
+ $client->resolver($self->resolver);
+ weaken $client->{resolver};
+
+ # Events
+ $c->{close} ||= delete $args->{on_close};
+ $c->{connect} ||= delete $args->{on_connect};
+ $c->{error} ||= delete $args->{on_error};
+ $c->{read} ||= delete $args->{on_read};
+ weaken $self;
+ $client->on(
+ connect => sub {
+ my $handle = pop;
+
+ # New stream
+ my $c = $self->{connections}->{$id};
+ delete $c->{client};
+ my $stream = $c->{stream} = $self->stream_class->new($handle);
+ $stream->iowatcher($self->iowatcher);
+ weaken $stream->{iowatcher};
+
+ # Events
+ $stream->on(
+ close => sub {
+ $c->{close}->($self, $id) if $c->{close};
+ $self->drop($id);
+ }
+ );
+ weaken $c;
+ $stream->on(
+ error => sub {
+ my $c = delete $self->{connections}->{$id};
+ $c->{error}->($self, $id, pop) if $c->{error};
+ }
+ );
+ $stream->on(
+ read => sub {
+ my $c = $self->{connections}->{$id};
+ $c->{active} = time;
+ $c->{read}->($self, $id, pop) if $c->{read};
+ }
+ );
+
+ # Connected
+ $stream->resume;
+ $self->write($id, @$_) for @{$c->{write} || []};
+ $c->{connect}->($self, $id) if $c->{connect};
+ }
+ );
+ $client->on(
+ error => sub {
+ my $c = delete $self->{connections}->{$id};
+ $c->{error}->($self, $id, pop) if $c->{error};
+ }
+ );
# Connect
- else { $self->_connect($id, $args) }
+ $args->{timeout} ||= $self->connect_timeout;
+ $client->connect($args);
return $id;
}
sub connection_timeout {
my ($self, $id, $timeout) = @_;
- return unless my $c = $self->{cs}->{$id};
- $c->{timeout} = $timeout and return $self if $timeout;
+ return unless my $c = $self->{connections}->{$id};
+ $c->{timeout} = $timeout and return $self if defined $timeout;
$c->{timeout};
}
sub drop {
my ($self, $id) = @_;
$self = $self->singleton unless ref $self;
-
- # Drop connections gracefully
- if (my $c = $self->{cs}->{$id}) { return $c->{finish} = 1 }
-
- # Drop everything else right away
+ if (my $c = $self->{connections}->{$id}) { return $c->{finish} = 1 }
$self->_drop($id);
}
-sub generate_port {
-
- # Try random ports
- my $port = 1 . int(rand 10) . int(rand 10) . int(rand 10) . int(rand 10);
- while ($port++ < 30000) {
- return $port
- if IO::Socket::INET->new(
- Listen => 5,
- LocalAddr => '127.0.0.1',
- LocalPort => $port,
- Proto => 'tcp'
- );
- }
+sub generate_port { Mojo::IOLoop::Server->generate_port }
- return;
+sub handle {
+ my ($self, $id) = @_;
+ return unless my $c = $self->{connections}->{$id};
+ return unless my $stream = $c->{stream};
+ return $stream->handle;
}
sub is_running {
@@ -239,109 +165,75 @@ sub listen {
$self = $self->singleton unless ref $self;
my $args = ref $_[0] ? $_[0] : {@_};
- # No TLS support
- croak "IO::Socket::SSL 1.43 required for TLS support"
- if $args->{tls} && !TLS;
-
- # Look for reusable file descriptor
- my $file = $args->{file};
- my $port = $args->{port} || 3000;
- my $reuse = defined $file ? $file : $port;
- $ENV{MOJO_REUSE} ||= '';
- my $fd;
- if ($ENV{MOJO_REUSE} =~ /(?:^|\,)$reuse\:(\d+)/) { $fd = $1 }
-
- # Stop listening so the new socket has a chance to join
- $self->_not_listening;
-
- # Allow file descriptor inheritance
- local $^F = 1000;
+ # New server
+ my $server = $self->server_class->new;
+ (my $id) = "$server" =~ /0x([\da-f]+)/;
+ $self->{servers}->{$id} = $server;
+ $server->iowatcher($self->iowatcher);
+ weaken $server->{iowatcher};
+
+ # Events
+ my $accept = delete $args->{on_accept};
+ my $close = delete $args->{on_close};
+ my $error = delete $args->{on_error};
+ my $read = delete $args->{on_read};
+ weaken $self;
+ $server->on(
+ accept => sub {
+ my $handle = pop;
+
+ # New stream
+ my $stream = $self->stream_class->new($handle);
+ (my $id) = "$stream" =~ /0x([\da-f]+)/;
+ my $c = $self->{connections}->{$id} ||= {};
+ $c->{stream} = $stream;
+ $stream->iowatcher($self->iowatcher);
+ weaken $stream->{iowatcher};
+
+ # Events
+ $c->{close} = $close;
+ $c->{error} = $error;
+ $c->{read} = $read;
+ $stream->on(
+ close => sub {
+ my $c = delete $self->{connections}->{$id};
+ $c->{close}->($self, $id) if $c->{close};
+ }
+ );
+ $stream->on(
+ error => sub {
+ my $c = delete $self->{connections}->{$id};
+ $c->{error}->($self, $id, pop) if $c->{error};
+ }
+ );
+ $stream->on(
+ read => sub {
+ my $c = $self->{connections}->{$id};
+ $c->{active} = time;
+ $c->{read}->($self, $id, pop) if $c->{read};
+ }
+ );
- # Listen on UNIX domain socket
- my $handle;
- my %options = (
- Listen => $args->{backlog} || SOMAXCONN,
- Proto => 'tcp',
- Type => SOCK_STREAM,
- %{$args->{args} || {}}
+ # Accept and enforce limit
+ $stream->resume;
+ $accept->($self, $id) if $accept;
+ $self->max_connections(0)
+ if defined $self->{accepts} && --$self->{accepts} == 0;
+ $self->_not_listening;
+ }
);
- if (defined $file) {
- $options{Local} = $file;
- $handle =
- defined $fd
- ? IO::Socket::UNIX->new
- : IO::Socket::UNIX->new(%options)
- or croak "Can't create listen socket: $!";
- }
-
- # Listen on TCP port
- else {
- $options{LocalAddr} = $args->{address} || '0.0.0.0';
- $options{LocalPort} = $port;
- $options{Proto} = 'tcp';
- $options{ReuseAddr} = 1;
- $options{LocalAddr} =~ s/[\[\]]//g;
- my $class = IPV6 ? 'IO::Socket::IP' : 'IO::Socket::INET';
- $handle = defined $fd ? $class->new : $class->new(%options)
- or croak "Can't create listen socket: $!";
- }
- # Reuse file descriptor
- if (defined $fd) {
- $handle->fdopen($fd, 'r')
- or croak "Can't open file descriptor $fd: $!";
- }
- else {
- $fd = fileno $handle;
- $reuse = ",$reuse" if length $ENV{MOJO_REUSE};
- $ENV{MOJO_REUSE} .= "$reuse:$fd";
- }
-
- # New connection
- my $c = {
- file => $args->{file} ? 1 : 0,
- on_accept => $args->{on_accept},
- on_close => $args->{on_close},
- on_error => $args->{on_error},
- on_read => $args->{on_read},
- };
- (my $id) = "$c" =~ /0x([\da-f]+)/;
- $self->{listen}->{$id} = $c;
- $c->{handle} = $handle;
- $self->{reverse}->{$handle} = $id;
-
- # TLS
- if ($args->{tls}) {
- my %options = (
- SSL_startHandshake => 0,
- SSL_cert_file => $args->{tls_cert} || $self->_cert_file,
- SSL_key_file => $args->{tls_key} || $self->_key_file,
- );
- %options = (
- SSL_verify_callback => $args->{tls_verify},
- SSL_ca_file => -T $args->{tls_ca} ? $args->{tls_ca} : undef,
- SSL_ca_path => -d $args->{tls_ca} ? $args->{tls_ca} : undef,
- SSL_verify_mode => $args->{tls_ca} ? 0x03 : undef,
- %options
- ) if $args->{tls_ca};
- $c->{tls} = {%options, %{$args->{tls_args} || {}}};
- }
-
- # Accept limit
+ # Listen
+ $server->listen($args);
$self->{accepts} = $self->max_accepts if $self->max_accepts;
+ $self->_not_listening;
return $id;
}
sub local_info {
my ($self, $id) = @_;
-
- # UNIX domain socket info
- return {} unless my $c = $self->{cs}->{$id};
- return {} unless my $handle = $c->{handle};
- return {path => $handle->hostpath} if $handle->can('hostpath');
-
- # TCP socket info
+ return {} unless my $handle = $self->handle($id);
return {address => $handle->sockhost, port => $handle->sockport};
}
@@ -349,34 +241,24 @@ sub on_close { shift->_event(close => @_) }
sub on_error { shift->_event(error => @_) }
sub on_read { shift->_event(read => @_) }
-sub recurring {
- my ($self, $after, $cb) = @_;
- $self = $self->singleton unless ref $self;
- weaken $self;
- return $self->iowatcher->recurring($after => sub { $self->$cb(pop) });
-}
-
sub one_tick {
my ($self, $timeout) = @_;
$timeout = $self->timeout unless defined $timeout;
# Housekeeping
$self->_listening;
- my $connections = $self->{cs} ||= {};
+ my $connections = $self->{connections} ||= {};
while (my ($id, $c) = each %$connections) {
# Connection needs to be finished
- if ($c->{finish} && !length $c->{buffer} && !$c->{drain}) {
+ if ($c->{finish} && (!$c->{stream} || $c->{stream}->is_finished)) {
$self->_drop($id);
next;
}
- # Read only
- $self->_not_writing($id) if delete $c->{read_only};
-
# Connection timeout
- my $time = $c->{active} ||= time;
- $self->_drop($id) if (time - $time) >= ($c->{timeout} || 15);
+ $self->_drop($id)
+ if (time - ($c->{active} || time)) >= ($c->{timeout} || 15);
}
# Graceful shutdown
@@ -386,21 +268,16 @@ sub one_tick {
$self->iowatcher->one_tick($timeout);
}
-sub handle {
- my ($self, $id) = @_;
- return unless my $c = $self->{cs}->{$id};
- return $c->{handle};
+sub recurring {
+ my ($self, $after, $cb) = @_;
+ $self = $self->singleton unless ref $self;
+ weaken $self;
+ return $self->iowatcher->recurring($after => sub { $self->$cb(pop) });
}
sub remote_info {
my ($self, $id) = @_;
-
- # UNIX domain socket info
- return {} unless my $c = $self->{cs}->{$id};
- return {} unless my $handle = $c->{handle};
- return {path => $handle->peerpath} if $handle->can('peerpath');
-
- # TCP socket info
+ return {} unless my $handle = $self->handle($id);
return {address => $handle->peerhost, port => $handle->peerport};
}
@@ -425,43 +302,12 @@ sub start_tls {
my $id = shift;
my $args = ref $_[0] ? $_[0] : {@_};
- # No TLS support
- unless (TLS) {
- $self->_error($id, 'IO::Socket::SSL 1.43 required for TLS support.');
- return;
- }
-
- # Cleanup
- $self->drop($id) and return unless my $c = $self->{cs}->{$id};
- $self->drop($id) and return unless my $handle = $c->{handle};
- delete $self->{reverse}->{$handle};
- my $watcher = $self->iowatcher->remove($handle);
-
- # TLS upgrade
- weaken $self;
- my %options = (
- SSL_startHandshake => 0,
- SSL_error_trap => sub { $self->_error($id, $_[1]) },
- SSL_cert_file => $args->{tls_cert},
- SSL_key_file => $args->{tls_key},
- SSL_verify_mode => 0x00,
- SSL_create_ctx_callback =>
- sub { Net::SSLeay::CTX_sess_set_cache_size(shift, 128) },
- Timeout => $self->connect_timeout,
- %{$args->{tls_args} || {}}
- );
- $self->drop($id) and return
- unless my $new = IO::Socket::SSL->start_SSL($handle, %options);
- $c->{handle} = $new;
- $self->{reverse}->{$new} = $id;
- $c->{tls_connect} = 1;
- $watcher->add(
- $new,
- on_readable => sub { $self->_read($id) },
- on_writable => sub { $self->_write($id) }
- )->writing($new);
-
- return $id;
+ # Steal handle and upgrade to TLS
+ my $stream = delete $self->{connections}->{$id}->{stream};
+ $args->{handle} = $stream->steal_handle;
+ $args->{id} = $id;
+ $args->{tls} = 1;
+ $self->connect($args);
}
sub stop {
@@ -472,9 +318,9 @@ sub stop {
sub test {
my ($self, $id) = @_;
- return unless my $c = $self->{cs}->{$id};
- return unless my $handle = $c->{handle};
- return $self->iowatcher->is_readable($handle);
+ return unless my $c = $self->{connections}->{$id};
+ return unless my $stream = $c->{stream};
+ return $self->iowatcher->is_readable($stream->handle);
}
sub timer {
@@ -487,410 +333,64 @@ sub timer {
sub write {
my ($self, $id, $chunk, $cb) = @_;
- # Prepare chunk for writing
- my $c = $self->{cs}->{$id};
- $c->{buffer} .= $chunk;
-
- # UNIX only quick write
- unless (WINDOWS) {
- $c->{drain} = 0 if $cb;
- $self->_write($id);
- }
-
- # Write with roundtrip
- $c->{drain} = $cb if $cb;
- $self->_writing($id) if $cb || length $c->{buffer};
-}
-
-sub _accept {
- my ($self, $listen) = @_;
-
- # Accept
- my $handle = $listen->accept or return;
- my $r = $self->{reverse};
- my $l = $self->{listen}->{$r->{$listen}};
-
- # New connection
- my $c = {buffer => ''};
- (my $id) = "$c" =~ /0x([\da-f]+)/;
- $self->{cs}->{$id} = $c;
-
- # TLS handshake
- weaken $self;
- if (my $tls = $l->{tls}) {
- $tls->{SSL_error_trap} = sub { $self->_error($id, $_[1]) };
- $handle = IO::Socket::SSL->start_SSL($handle, %$tls);
- $c->{tls_accept} = 1;
- }
-
- # Start watching for events
- $self->iowatcher->add(
- $handle,
- on_readable => sub { $self->_read($id) },
- on_writable => sub { $self->_write($id) }
- );
- $c->{handle} = $handle;
- $r->{$handle} = $id;
-
- # Non-blocking
- $handle->blocking(0);
-
- # Disable Nagle's algorithm
- setsockopt($handle, IPPROTO_TCP, TCP_NODELAY, 1) unless $l->{file};
-
- # Register callbacks
- for my $name (qw/on_close on_error on_read/) {
- my $cb = $l->{$name};
- $self->$name($id => $cb) if $cb;
- }
-
- # Accept limit
- $self->max_connections(0)
- if defined $self->{accepts} && --$self->{accepts} == 0;
-
- # Accept callback
- warn "ACCEPTED $id\n" if DEBUG;
- if ((my $cb = $c->{on_accept} = $l->{on_accept}) && !$l->{tls}) {
- $self->_sandbox('accept', $cb, $id);
- }
-
- # Stop listening
- $self->_not_listening;
-}
-
-sub _cert_file {
- my $self = shift;
-
- # Check if temporary TLS cert file already exists
- my $cert = $self->{cert};
- return $cert if $cert && -r $cert;
-
- # Create temporary TLS cert file
- $cert = File::Spec->catfile($ENV{MOJO_TMPDIR} || File::Spec->tmpdir,
- 'mojocert.pem');
- croak qq/Can't create temporary TLS cert file "$cert"/
- unless my $file = IO::File->new("> $cert");
- print $file CERT;
-
- $self->{cert} = $cert;
-}
-
-sub _connect {
- my ($self, $id, $args) = @_;
-
- # New handle
- my $handle;
- return unless my $c = $self->{cs}->{$id};
- unless ($handle = $args->{handle}) {
-
- # New socket
- my %options = (
- Blocking => 0,
- PeerAddr => $args->{address},
- PeerPort => $args->{port} || ($args->{tls} ? 443 : 80),
- Proto => $args->{proto},
- Type => $args->{proto} eq 'udp' ? SOCK_DGRAM : SOCK_STREAM,
- %{$args->{args} || {}}
- );
- $options{PeerAddr} =~ s/[\[\]]//g if $options{PeerAddr};
- my $class = IPV6 ? 'IO::Socket::IP' : 'IO::Socket::INET';
- return $self->_error($id, "Couldn't connect.")
- unless $handle = $class->new(%options);
-
- # Timer
- $c->{connect_timer} =
- $self->timer($self->connect_timeout,
- sub { shift->_error($id, 'Connect timeout.') });
-
- # IPv6 needs an early start
- $handle->connect if IPV6;
+ # Write right away
+ my $c = $self->{connections}->{$id};
+ $c->{active} = time;
+ if (my $stream = $c->{stream}) {
+ return $stream->write($chunk) unless $cb;
+ weaken $self;
+ return $stream->write($chunk, sub { $self->$cb($id) });
}
- $c->{handle} = $handle;
- $self->{reverse}->{$handle} = $id;
-
- # Non-blocking
- $handle->blocking(0);
- # Start writing right away
- $self->iowatcher->add(
- $handle,
- on_readable => sub { $self->_read($id) },
- on_writable => sub { $self->_write($id) }
- )->writing($handle);
-
- # Start TLS
- if ($args->{tls}) { $self->start_tls($id => $args) }
+ # Delayed write
+ $c->{write} ||= [];
+ push @{$c->{write}}, [$chunk, $cb];
}
sub _drop {
my ($self, $id) = @_;
-
- # Cancel timer
return $self unless my $watcher = $self->iowatcher;
return $self if $watcher->cancel($id);
-
- # Drop listen socket
- my $c = $self->{cs}->{$id};
- if ($c) { return if $c->{drop}++ }
- elsif ($c = delete $self->{listen}->{$id}) {
- return $self unless $self->{listening};
- delete $self->{listening};
- }
-
- # Delete associated timers
- if (my $t = $c->{connect_timer} || $c->{accept_timer}) { $self->_drop($t) }
-
- # Drop handle
- if (my $handle = $c->{handle}) {
- warn "DISCONNECTED $id\n" if DEBUG;
-
- # Handle close
- if (my $cb = $c->{close}) { $self->_sandbox('close', $cb, $id) }
-
- # Cleanup
- delete $self->{cs}->{$id};
- delete $self->{reverse}->{$handle};
- $watcher->remove($handle);
- close $handle;
- }
-
+ if (delete $self->{servers}->{$id}) { delete $self->{listening} }
+ else { delete((delete($self->{connections}->{$id}) || {})->{stream}) }
return $self;
}
-sub _error {
- my ($self, $id, $error) = @_;
- $error ||= 'Unknown error, probably harmless.';
- warn qq/ERROR $id "$error"\n/ if DEBUG;
-
- # Handle error
- return unless my $c = $self->{cs}->{$id};
- if (my $cb = $c->{error}) { $self->_sandbox('error', $cb, $id, $error) }
- else { warn "Unhandled event error: $error" and return }
- $self->_drop($id);
-}
-
sub _event {
my ($self, $event, $id, $cb) = @_;
- return unless my $c = $self->{cs}->{$id};
+ return unless my $c = $self->{connections}->{$id};
$c->{$event} = $cb if $cb;
return $self;
}
-sub _key_file {
- my $self = shift;
-
- # Check if temporary TLS key file already exists
- my $key = $self->{key};
- return $key if $key && -r $key;
-
- # Create temporary TLS key file
- $key = File::Spec->catfile($ENV{MOJO_TMPDIR} || File::Spec->tmpdir,
- 'mojokey.pem');
- croak qq/Can't create temporary TLS key file "$key"/
- unless my $file = IO::File->new("> $key");
- print $file KEY;
-
- $self->{key} = $key;
-}
-
sub _listening {
my $self = shift;
- # Already listening or no listen sockets
+ # Check if we should be listening
return if $self->{listening};
- my $listen = $self->{listen} ||= {};
- return unless keys %$listen;
-
- # Check if we are allowed to listen and lock
- my $i = keys %{$self->{cs}};
+ my $servers = $self->{servers} ||= {};
+ return unless keys %$servers;
+ my $i = keys %{$self->{connections}};
return unless $i < $self->max_connections;
return unless $self->on_lock->($self, !$i);
- # Listen
- weaken $self;
- my $watcher = $self->iowatcher;
- for my $lid (keys %$listen) {
- $watcher->add($listen->{$lid}->{handle},
- on_readable => sub { $self->_accept(pop) });
- }
+ # Start listening
+ $_->resume for values %$servers;
$self->{listening} = 1;
}
sub _not_listening {
my $self = shift;
- # Check if we are listening and unlock
+ # Check if we are listening
return unless delete $self->{listening};
$self->on_unlock->($self);
# Stop listening
- my $listen = $self->{listen} || {};
- $self->iowatcher->remove($listen->{$_}->{handle}) for keys %$listen;
+ $_->pause for values %{$self->{servers} || {}};
delete $self->{listening};
}
-sub _not_writing {
- my ($self, $id) = @_;
- return unless my $c = $self->{cs}->{$id};
- return $c->{read_only} = 1 if length $c->{buffer} || $c->{drain};
- return unless my $handle = $c->{handle};
- $self->iowatcher->not_writing($handle);
-}
-
-sub _read {
- my ($self, $id) = @_;
-
- # Check if everything is ready to read
- my $c = $self->{cs}->{$id};
- return $self->_tls_accept($id) if $c->{tls_accept};
- return $self->_tls_connect($id) if $c->{tls_connect};
- return unless defined(my $handle = $c->{handle});
-
- # Read
- my $read = $handle->sysread(my $buffer, CHUNK_SIZE, 0);
-
- # Error
- unless (defined $read) {
-
- # Retry
- return if $! == EAGAIN || $! == EINTR || $! == EWOULDBLOCK;
-
- # Connection reset
- return $self->_drop($id) if $! == ECONNRESET;
-
- # Read error
- return $self->_error($id, $!);
- }
-
- # EOF
- return $self->_drop($id) if $read == 0;
-
- # Handle read
- if (my $cb = $c->{read}) { $self->_sandbox('read', $cb, $id, $buffer) }
-
- # Active
- $c->{active} = time;
-}
-
-sub _sandbox {
- my $self = shift;
- my $event = shift;
- my $cb = shift;
- my $id = shift;
-
- # Sandbox event
- unless (eval { $self->$cb($id, @_); 1 }) {
- my $message = qq/Event "$event" failed for connection "$id": $@/;
- $event eq 'error'
- ? ($self->_drop($id) and warn $message)
- : $self->_error($id, $message);
- }
-}
-
-sub _tls_accept {
- my ($self, $id) = @_;
-
- # Accepted
- my $c = $self->{cs}->{$id};
- if ($c->{handle}->accept_SSL) {
-
- # Handle TLS accept
- delete $c->{tls_accept};
- if (my $cb = $c->{on_accept}) { $self->_sandbox('accept', $cb, $id) }
- return;
- }
-
- # Switch between reading and writing
- $self->_tls_error($id);
-}
-
-sub _tls_connect {
- my ($self, $id) = @_;
-
- # Connected
- my $c = $self->{cs}->{$id};
- if ($c->{handle}->connect_SSL) {
-
- # Handle TLS connect
- delete $c->{tls_connect};
- if (my $cb = $c->{on_connect}) { $self->_sandbox('connect', $cb, $id) }
- return;
- }
-
- # Switch between reading and writing
- $self->_tls_error($id);
-}
-
-sub _tls_error {
- my ($self, $id) = @_;
- my $error = $IO::Socket::SSL::SSL_ERROR;
- if ($error == TLS_READ) { $self->_not_writing($id) }
- elsif ($error == TLS_WRITE) { $self->_writing($id) }
-}
-
-sub _write {
- my ($self, $id) = @_;
-
- # Check if we are ready for writing
- my $c = $self->{cs}->{$id};
- return $self->_tls_accept($id) if $c->{tls_accept};
- return $self->_tls_connect($id) if $c->{tls_connect};
- return unless my $handle = $c->{handle};
-
- # Connected
- if ($c->{connecting}) {
- delete $c->{connecting};
- my $timer = delete $c->{connect_timer};
- $self->_drop($timer) if $timer;
-
- # Disable Nagle's algorithm
- setsockopt $handle, IPPROTO_TCP, TCP_NODELAY, 1;
-
- # Handle connect
- warn "CONNECTED $id\n" if DEBUG;
- if (!$c->{tls} && (my $cb = $c->{on_connect})) {
- $self->_sandbox('connect', $cb, $id);
- }
- }
-
- # Handle drain
- if (!length $c->{buffer} && (my $cb = delete $c->{drain})) {
- $self->_sandbox('drain', $cb, $id);
- }
-
- # Write as much as possible
- if (length $c->{buffer}) {
- my $written = $handle->syswrite($c->{buffer});
-
- # Error
- unless (defined $written) {
-
- # Retry
- return if $! == EAGAIN || $! == EINTR || $! == EWOULDBLOCK;
-
- # Write error
- return $self->_error($id, $!);
- }
-
- # Remove written chunk from buffer
- substr $c->{buffer}, 0, $written, '';
-
- # Active
- $c->{active} = time;
- }
-
- # Not writing
- $self->_not_writing($id) unless exists $c->{drain} || length $c->{buffer};
-}
-
-sub _writing {
- my ($self, $id) = @_;
- my $c = $self->{cs}->{$id};
- delete $c->{read_only};
- return unless my $handle = $c->{handle};
- $self->iowatcher->writing($handle);
-}
-
1;
__END__
@@ -951,8 +451,8 @@ L<Mojo::IOLoop> is a very minimalistic reactor that has been reduced to the
absolute minimal feature set required to build solid and scalable async TCP
clients and servers.
-Optional modules L<IO::KQueue>, L<IO::Epoll>, L<IO::Socket::IP> and
-L<IO::Socket::SSL> are supported transparently and used if installed.
+Optional modules L<EV>, L<IO::Socket::IP> and L<IO::Socket::SSL> are
+supported transparently and used if installed.
A TLS certificate and key are also built right in to make writing test
servers as easy as possible.
@@ -961,20 +461,21 @@ servers as easy as possible.
L<Mojo::IOLoop> implements the following attributes.
-=head2 C<accept_timeout>
+=head2 C<client_class>
- my $timeout = $loop->accept_timeout;
- $loop = $loop->accept_timeout(5);
+ my $class = $loop->client_class;
+ $loop = $loop->client_class('Mojo::IOLoop::Client');
-Maximum time in seconds a connection can take to be accepted before being
-dropped, defaults to C<3>.
+Class to be used for performing non-blocking socket connections with the
+C<connect> method, defaults to L<Mojo::IOLoop::Client>.
+Note that this attribute is EXPERIMENTAL and might change without warning!
=head2 C<connect_timeout>
my $timeout = $loop->connect_timeout;
$loop = $loop->connect_timeout(5);
-Maximum time in seconds a conenction can take to be connected before being
+Maximum time in seconds a connection can take to be connected before being
dropped, defaults to C<3>.
=head2 C<iowatcher>
@@ -982,8 +483,8 @@ dropped, defaults to C<3>.
my $watcher = $loop->iowatcher;
$loop = $loop->iowatcher(Mojo::IOWatcher->new);
-Low level event watcher, usually a L<Mojo::IOWatcher>,
-L<Mojo::IOWatcher::KQueue> or L<Mojo::IOLoop::Epoll> object.
+Low level event watcher, usually a L<Mojo::IOWatcher> or
+L<Mojo::IOWatcher::EV> object.
Replacing the event watcher of the singleton loop makes all new loops use the
same type of event watcher.
Note that this attribute is EXPERIMENTAL and might change without warning!
@@ -1041,9 +542,26 @@ Note that exceptions in this callback are not captured.
=head2 C<resolver>
my $resolver = $loop->resolver;
- $loop = $loop->resolver(Mojo::Resolver->new);
+ $loop = $loop->resolver(Mojo::IOLoop::Resolver->new);
-DNS stub resolver, usually a L<Mojo::Resolver> object.
+DNS stub resolver, usually a L<Mojo::IOLoop::Resolver> object.
+Note that this attribute is EXPERIMENTAL and might change without warning!
+
+=head2 C<server_class>
+
+ my $class = $loop->server_class;
+ $loop = $loop->server_class('Mojo::IOLoop::Server');
+
+Class to be used for accepting incoming connections with the C<listen>
+method, defaults to L<Mojo::IOLoop::Server>.
+Note that this attribute is EXPERIMENTAL and might change without warning!
+
+=head2 C<stream_class>
+
+ my $class = $loop->stream_class;
+ $loop = $loop->stream_class('Mojo::IOLoop::Stream');
+
+Class to be used for streaming handles, defaults to L<Mojo::IOLoop::Stream>.
Note that this attribute is EXPERIMENTAL and might change without warning!
=head2 C<timeout>
@@ -1105,7 +623,7 @@ Callback to be invoked if the connection gets closed.
=item C<on_error>
-Callback to be invoked if an error event happens on the connection.
+Callback to be invoked if an error happens on the connection.
=item C<on_read>
@@ -1115,10 +633,6 @@ Callback to be invoked if new data arrives on the connection.
Port to connect to.
-=item C<proto>
-
-Protocol to use, defaults to C<tcp>.
-
=item C<tls>
Enable TLS.
@@ -1178,7 +692,6 @@ Check if loop is running.
my $id = Mojo::IOLoop->listen(port => 3000);
my $id = $loop->listen(port => 3000);
my $id = $loop->listen({port => 3000});
- my $id = $loop->listen(file => '/foo/myapp.sock');
my $id = $loop->listen(
port => 443,
tls => 1,
@@ -1202,10 +715,6 @@ Local address to listen on, defaults to all.
Maximum backlog size, defaults to C<SOMAXCONN>.
-=item C<file>
-
-A unix domain socket to listen on.
-
=item C<on_accept>
Callback to be invoked for each accepted connection.
@@ -1216,7 +725,7 @@ Callback to be invoked if the connection gets closed.
=item C<on_error>
-Callback to be invoked if an error event happens on the connection.
+Callback to be invoked if an error happens on the connection.
=item C<on_read>
@@ -1276,7 +785,7 @@ Callback to be invoked if the connection gets closed.
$loop = $loop->on_error($id => sub {...});
-Callback to be invoked if an error event happens on the connection.
+Callback to be invoked if an error happens on the connection.
=head2 C<on_read>
@@ -1357,7 +866,7 @@ if the loop is already running.
=head2 C<start_tls>
- my $id = $loop->start_tls($id);
+ $loop->start_tls($id);
Start new TLS connection inside old connection.
Note that TLS support depends on L<IO::Socket::SSL>.
@@ -0,0 +1,164 @@
+package Mojo::IOWatcher::EV;
+use Mojo::Base 'Mojo::IOWatcher';
+
+use EV;
+use Scalar::Util 'weaken';
+
+my $SINGLETON;
+
+sub DESTROY { undef $SINGLETON }
+
+# We have to fall back to Mojo::IOWatcher, since EV is unique
+sub new { $SINGLETON++ ? Mojo::IOWatcher->new : shift->SUPER::new }
+
+sub not_writing {
+ my ($self, $handle) = @_;
+
+ my $fd = fileno $handle;
+ my $h = $self->{handles}->{$fd};
+ my $w = $h->{watcher};
+ if ($w) { $w->set($fd, EV::READ) if delete $h->{writing} }
+ else {
+ weaken $self;
+ $h->{watcher} = EV::io($fd, EV::READ, sub { $self->_io($fd, @_) });
+ }
+
+ return $self;
+}
+
+# "Wow, Barney. You brought a whole beer keg.
+# Yeah... where do I fill it up?"
+sub one_tick {
+ my ($self, $timeout) = @_;
+ my $w = EV::timer($timeout, 0, sub { EV::unloop(EV::BREAK_ONE) });
+ EV::loop;
+ undef $w;
+}
+
+sub recurring { shift->_timer(shift, 1, @_) }
+
+sub remove {
+ my ($self, $handle) = @_;
+ delete $self->{handles}->{fileno $handle};
+ return $self;
+}
+
+sub timer { shift->_timer(shift, 0, @_) }
+
+sub writing {
+ my ($self, $handle) = @_;
+
+ my $fd = fileno $handle;
+ my $h = $self->{handles}->{$fd};
+ my $w = $h->{watcher};
+ if ($w) { $w->set($fd, EV::WRITE | EV::READ) }
+ else {
+ weaken $self;
+ $h->{watcher} =
+ EV::io($fd, EV::WRITE | EV::READ, sub { $self->_io($fd, @_) });
+ }
+ $h->{writing} = 1;
+
+ return $self;
+}
+
+sub _io {
+ my ($self, $fd, $w, $revents) = @_;
+ my $h = $self->{handles}->{$fd};
+ $self->_sandbox('Read', $h->{on_readable}, $h->{handle})
+ if EV::READ &$revents;
+ $self->_sandbox('Write', $h->{on_writable}, $h->{handle})
+ if EV::WRITE &$revents;
+}
+
+sub _timer {
+ my $self = shift;
+ my $after = shift || '0.0001';
+ my $recurring = shift;
+ my $cb = shift;
+
+ my $id = $self->SUPER::_timer($cb);
+ weaken $self;
+ $self->{timers}->{$id}->{watcher} = EV::timer(
+ $after,
+ $recurring ? $after : 0,
+ sub {
+ my $w = shift;
+ $self->_sandbox("Timer $id", $self->{timers}->{$id}->{cb}, $id);
+ delete $self->{timers}->{$id} unless $recurring;
+ }
+ );
+
+ return $id;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+Mojo::IOWatcher::EV - EV Async I/O Watcher
+
+=head1 SYNOPSIS
+
+ use Mojo::IOWatcher::EV;
+
+=head1 DESCRIPTION
+
+L<Mojo::IOWatcher::EV> is a minimalistic async I/O watcher with C<libev>
+support.
+Note that this module is EXPERIMENTAL and might change without warning!
+
+=head1 METHODS
+
+L<Mojo::IOWatcher::EV> inherits all methods from L<Mojo::IOWatcher> and
+implements the following new ones.
+
+=head2 C<new>
+
+ my $watcher = Mojo::IOWatcher::EV->new;
+
+Construct a new L<Mojo::IOWatcher::EV> object.
+
+=head2 C<not_writing>
+
+ $watcher = $watcher->not_writing($handle);
+
+Only watch handle for readable events.
+
+=head2 C<one_tick>
+
+ $watcher->one_tick('0.25');
+
+Run for exactly one tick and watch for I/O and timer events.
+
+=head2 C<recurring>
+
+ my $id = $watcher->recurring(3 => sub {...});
+
+Create a new recurring timer, invoking the callback repeatedly after a given
+amount of seconds.
+
+=head2 C<remove>
+
+ $watcher = $watcher->remove($handle);
+
+Remove handle.
+
+=head2 C<timer>
+
+ my $id = $watcher->timer(3 => sub {...});
+
+Create a new timer, invoking the callback after a given amount of seconds.
+
+=head2 C<writing>
+
+ $watcher = $watcher->writing($handle);
+
+Watch handle for readable and writable events.
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>.
+
+=cut
@@ -1,37 +0,0 @@
-package Mojo::IOWatcher::Epoll;
-use Mojo::Base 'Mojo::IOWatcher';
-
-use IO::Epoll 0.02 ':compat';
-use Time::HiRes 'usleep';
-
-# "And America has so many enemies.
-# Iran, Iraq, China, Mordor, the hoochies that laid low Tiger Woods,
-# undesirable immigrants - by which I mean everyone that came after me,
-# including my children..."
-sub _poll { shift->{poll} ||= IO::Epoll->new }
-
-1;
-__END__
-
-=head1 NAME
-
-Mojo::IOWatcher::Epoll - Epoll Async IO Watcher
-
-=head1 SYNOPSIS
-
- use Mojo::IOWatcher::Epoll;
-
-=head1 DESCRIPTION
-
-L<Mojo::IOWatcher> is a minimalistic async io watcher with C<epoll> support.
-Note that this module is EXPERIMENTAL and might change without warning!
-
-=head1 METHODS
-
-L<Mojo::IOWatcher::Epoll> inherits all methods from L<Mojo::IOWatcher>.
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>.
-
-=cut
@@ -1,113 +0,0 @@
-package Mojo::IOWatcher::KQueue;
-use Mojo::Base 'Mojo::IOWatcher';
-
-use IO::KQueue 0.34;
-
-# "Wow, Barney. You brought a whole beer keg.
-# Yeah... where do I fill it up?"
-sub not_writing {
- my ($self, $handle) = @_;
-
- my $fd = fileno $handle;
- my $h = $self->{handles}->{$fd};
- my $kqueue = $self->_kqueue;
- $kqueue->EV_SET($fd, EVFILT_READ, EV_ADD)
- unless defined $h->{writing};
- $kqueue->EV_SET($fd, EVFILT_WRITE, EV_DELETE) if $h->{writing};
- $h->{writing} = 0;
-
- return $self;
-}
-
-sub remove {
- my ($self, $handle) = @_;
-
- my $fd = fileno $handle;
- my $h = delete $self->{handles}->{$fd};
- my $kqueue = $self->_kqueue;
- $kqueue->EV_SET($fd, EVFILT_READ, EV_DELETE) if defined $h->{writing};
- $kqueue->EV_SET($fd, EVFILT_WRITE, EV_DELETE) if $h->{writing};
-
- return $self;
-}
-
-sub watch {
- my ($self, $timeout) = @_;
-
- my @ret;
- eval { @ret = $self->_kqueue->kevent(1000 * $timeout) };
- for my $kev (@ret) {
- my ($fd, $filter, $flags, $fflags) = @$kev;
- my $h = $self->{handles}->{$fd};
- $self->_sandbox('Read', $h->{on_readable}, $h->{handle})
- if $filter == EVFILT_READ || $flags == EV_EOF;
- $self->_sandbox('Write', $h->{on_writable}, $h->{handle})
- if $filter == EVFILT_WRITE;
- }
-}
-
-sub writing {
- my ($self, $handle) = @_;
-
- my $fd = fileno $handle;
- my $h = $self->{handles}->{$fd};
- $self->_kqueue->EV_SET($fd, EVFILT_READ, EV_ADD)
- unless defined $h->{writing};
- $self->_kqueue->EV_SET($fd, EVFILT_WRITE, EV_ADD) unless $h->{writing};
- $h->{writing} = 1;
-
- return $self;
-}
-
-sub _kqueue { shift->{kqueue} ||= IO::KQueue->new }
-
-1;
-__END__
-
-=head1 NAME
-
-Mojo::IOWatcher::KQueue - KQueue Async IO Watcher
-
-=head1 SYNOPSIS
-
- use Mojo::IOWatcher::KQueue;
-
-=head1 DESCRIPTION
-
-L<Mojo::IOWatcher> is a minimalistic async io watcher with C<kqueue> support.
-Note that this module is EXPERIMENTAL and might change without warning!
-
-=head1 METHODS
-
-L<Mojo::IOWatcher::KQueue> inherits all methods from L<Mojo::IOWatcher> and
-implements the following new ones.
-
-=head2 C<not_writing>
-
- $watcher = $watcher->not_writing($handle);
-
-Only watch handle for readable events.
-
-=head2 C<remove>
-
- $watcher = $watcher->remove($handle);
-
-Remove handle.
-
-=head2 C<watch>
-
- $watcher->watch('0.25');
-
-Run for exactly one tick and watch only for io events.
-
-=head2 C<writing>
-
- $watcher = $watcher->writing($handle);
-
-Watch handle for readable and writable events.
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>.
-
-=cut
@@ -30,6 +30,12 @@ sub cancel {
return;
}
+sub detect {
+ my $try = $ENV{MOJO_IOWATCHER} || 'Mojo::IOWatcher::EV';
+ return $try if eval "use $try; 1";
+ return 'Mojo::IOWatcher';
+}
+
sub is_readable {
my ($self, $handle) = @_;
@@ -50,7 +56,7 @@ sub not_writing {
my $poll = $self->_poll;
$poll->remove($handle)
if delete $self->{handles}->{fileno $handle}->{writing};
- $poll->mask($handle, $self->POLLIN);
+ $poll->mask($handle, POLLIN);
return $self;
}
@@ -59,8 +65,17 @@ sub not_writing {
sub one_tick {
my ($self, $timeout) = @_;
- # IO
- $self->watch($timeout);
+ # I/O
+ my $poll = $self->_poll;
+ $poll->poll($timeout);
+ my $handles = $self->{handles};
+ $self->_sandbox('Read', $handles->{fileno $_}->{on_readable}, $_)
+ for $poll->handles(POLLIN | POLLHUP | POLLERR);
+ $self->_sandbox('Write', $handles->{fileno $_}->{on_writable}, $_)
+ for $poll->handles(POLLOUT);
+
+ # Wait for timeout
+ usleep 1000000 * $timeout unless keys %{$self->{handles}};
# Timers
my $timers = $self->{timers} || {};
@@ -82,10 +97,7 @@ sub one_tick {
}
}
-sub recurring {
- my $self = shift;
- $self->_event(timers => pop, after => pop, recurring => time);
-}
+sub recurring { shift->_timer(pop, after => pop, recurring => time) }
sub remove {
my ($self, $handle) = @_;
@@ -96,48 +108,25 @@ sub remove {
# "Bart, how did you get a cellphone?
# The same way you got me, by accident on a golf course."
-sub timer {
- my $self = shift;
- $self->_event(timers => pop, after => pop, started => time);
-}
-
-sub watch {
- my ($self, $timeout) = @_;
-
- # Check for IO events
- my $poll = $self->_poll;
- $poll->poll($timeout);
- my $handles = $self->{handles};
- $self->_sandbox('Read', $handles->{fileno $_}->{on_readable}, $_)
- for $poll->handles($self->POLLIN | $self->POLLHUP | $self->POLLERR);
- $self->_sandbox('Write', $handles->{fileno $_}->{on_writable}, $_)
- for $poll->handles($self->POLLOUT);
-
- # Wait for timeout
- usleep 1000000 * $timeout unless keys %{$self->{handles}};
-}
+sub timer { shift->_timer(pop, after => pop, started => time) }
sub writing {
my ($self, $handle) = @_;
my $poll = $self->_poll;
$poll->remove($handle);
- $poll->mask($handle, $self->POLLIN | $self->POLLOUT);
+ $poll->mask($handle, POLLIN | POLLOUT);
$self->{handles}->{fileno $handle}->{writing} = 1;
return $self;
}
-sub _event {
+sub _timer {
my $self = shift;
- my $pool = shift;
my $cb = shift;
-
- # Events have an id for easy removal
- my $e = {cb => $cb, @_};
- (my $id) = "$e" =~ /0x([\da-f]+)/;
- $self->{$pool}->{$id} = $e;
-
+ my $t = {cb => $cb, @_};
+ (my $id) = "$t" =~ /0x([\da-f]+)/;
+ $self->{timers}->{$id} = $t;
return $id;
}
@@ -155,13 +144,13 @@ __END__
=head1 NAME
-Mojo::IOWatcher - Async IO Watcher
+Mojo::IOWatcher - Async I/O Watcher
=head1 SYNOPSIS
use Mojo::IOWatcher;
- # Watch if io handles become readable or writable
+ # Watch if I/O handles become readable or writable
my $watcher = Mojo::IOWatcher->new;
$watcher->add($handle, on_readable => sub {
my ($watcher, $handle) = @_;
@@ -180,10 +169,9 @@ Mojo::IOWatcher - Async IO Watcher
=head1 DESCRIPTION
-L<Mojo::IOWatcher> is a minimalistic async io watcher and the foundation of
+L<Mojo::IOWatcher> is a minimalistic async I/O watcher and the foundation of
L<Mojo::IOLoop>.
-L<Mojo::IOWatcher::KQueue> and L<Mojo::IOWatcher::Epoll> are good examples
-for its extensibility.
+L<Mojo::IOWatcher::EV> is a good example for its extensibility.
Note that this module is EXPERIMENTAL and might change without warning!
=head1 METHODS
@@ -195,7 +183,7 @@ following new ones.
$watcher = $watcher->add($handle, on_readable => sub {...});
-Add handles and watch for io events.
+Add handles and watch for I/O events.
These options are currently available:
@@ -217,6 +205,14 @@ Callback to be invoked once the handle becomes writable.
Cancel timer.
+=head2 C<detect>
+
+ my $class = Mojo::IOWatcher->detect;
+
+Detect and load the best watcher implementation available, will try the value
+of the C<MOJO_IOWATCHER> environment variable or L<Mojo::IOWatcher::EV>.
+Note that this method is EXPERIMENTAL and might change without warning!
+
=head2 C<is_readable>
my $readable = $watcher->is_readable($handle);
@@ -234,7 +230,7 @@ Only watch handle for readable events.
$watcher->one_tick('0.25');
-Run for exactly one tick and watch for io and timer events.
+Run for exactly one tick and watch for I/O and timer events.
=head2 C<recurring>
@@ -255,12 +251,6 @@ Remove handle.
Create a new timer, invoking the callback after a given amount of seconds.
-=head2 C<watch>
-
- $watcher->watch('0.25');
-
-Run for exactly one tick and watch only for io events.
-
=head2 C<writing>
$watcher = $watcher->writing($handle);
@@ -63,7 +63,6 @@ sub search {
}
}
- return unless @$modules;
return $modules;
}
@@ -78,9 +77,14 @@ Mojo::Loader - Loader
use Mojo::Loader;
+ # Find modules in a namespace
my $loader = Mojo::Loader->new;
- my $modules = $loader->search('Some::Namespace');
- $loader->load($modules->[0]);
+ for my $module (@{$loader->search('Some::Namespace')}) {
+
+ # And load them safely
+ my $e = $loader->load($module);
+ warn qq/Loading "$module" failed: $e/ if ref $e;
+ }
=head1 DESCRIPTION
@@ -109,8 +113,6 @@ loaded.
Search for modules in a namespace non-recursively.
- $loader->load($_) for @{$loader->search('MyApp::Namespace')};
-
=head1 SEE ALSO
L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>.
@@ -1,391 +0,0 @@
-package Mojo::Resolver;
-use Mojo::Base -base;
-
-use List::Util 'first';
-use Mojo::IOLoop;
-use Mojo::URL;
-
-use constant DEBUG => $ENV{MOJO_RESOLVER_DEBUG} || 0;
-
-# "AF_INET6" requires Socket6 or Perl 5.12
-use constant IPV6_AF_INET6 => eval { Socket::AF_INET6() }
- || eval { require Socket6 and Socket6::AF_INET6() };
-
-# "inet_pton" requires Socket6 or Perl 5.12
-BEGIN {
-
- # Socket
- if (defined &Socket::inet_pton) { *inet_pton = \&Socket::inet_pton }
-
- # Socket6
- elsif (eval { require Socket6 and defined &Socket6::inet_pton }) {
- *inet_pton = \&Socket6::inet_pton;
- }
-}
-
-# IPv6 DNS support requires "AF_INET6" and "inet_pton"
-use constant IPV6 => defined IPV6_AF_INET6 && defined &inet_pton;
-
-has ioloop => sub { Mojo::IOLoop->new };
-has timeout => 3;
-
-# DNS server (default to Google Public DNS)
-my $SERVERS = ['8.8.8.8', '8.8.4.4'];
-
-# Try to detect DNS server
-if (-r '/etc/resolv.conf') {
- my $file = IO::File->new('< /etc/resolv.conf');
- my @servers;
- for my $line (<$file>) {
-
- # New DNS server
- if ($line =~ /^nameserver\s+(\S+)$/) {
- push @servers, $1;
- warn qq/DETECTED DNS SERVER ($1)\n/ if DEBUG;
- }
- }
- unshift @$SERVERS, @servers;
-}
-
-# User defined DNS server
-unshift @$SERVERS, $ENV{MOJO_DNS_SERVER} if $ENV{MOJO_DNS_SERVER};
-
-# Always start with first DNS server
-my $CURRENT_SERVER = 0;
-
-# DNS record types
-my $DNS_TYPES = {
- '*' => 0x00ff,
- A => 0x0001,
- AAAA => 0x001c,
- CNAME => 0x0005,
- MX => 0x000f,
- NS => 0x0002,
- PTR => 0x000c,
- TXT => 0x0010
-};
-
-# "localhost"
-our $LOCALHOST = '127.0.0.1';
-
-sub lookup {
- my ($self, $name, $cb) = @_;
-
- # "localhost"
- my $loop = $self->ioloop;
- return $loop->timer(0 => sub { shift->$cb($LOCALHOST) })
- if $name eq 'localhost';
-
- # IPv4
- $self->resolve(
- $name, 'A',
- sub {
- my ($self, $records) = @_;
-
- # Success
- my $result = first { $_->[0] eq 'A' } @$records;
- return $self->$cb($result->[1]) if $result;
-
- # IPv6
- $self->resolve(
- $name, 'AAAA',
- sub {
- my ($self, $records) = @_;
-
- # Success
- my $result = first { $_->[0] eq 'AAAA' } @$records;
- return $self->$cb($result->[1]) if $result;
-
- # Pass through
- $self->$cb();
- }
- );
- }
- );
-}
-
-# "I can't believe it! Reading and writing actually paid off!"
-sub resolve {
- my ($self, $name, $type, $cb) = @_;
-
- # No lookup required or record type not supported
- my $ipv4 = $name =~ $Mojo::URL::IPV4_RE ? 1 : 0;
- my $ipv6 = IPV6 && $name =~ $Mojo::URL::IPV6_RE ? 1 : 0;
- my $t = $DNS_TYPES->{$type};
- my $server = $self->servers;
- my $loop = $self->ioloop;
- if (!$server || !$t || ($t ne $DNS_TYPES->{PTR} && ($ipv4 || $ipv6))) {
- $loop->timer(0 => sub { $self->$cb([]) });
- return $self;
- }
-
- # Request
- warn "RESOLVE $type $name ($server)\n" if DEBUG;
- my $timer;
- my $tx = int rand 0x10000;
- my $id = $loop->connect(
- address => $server,
- port => 53,
- proto => 'udp',
- on_connect => sub {
- my ($loop, $id) = @_;
-
- # Header (one question with recursion)
- my $req = pack 'nnnnnn', $tx, 0x0100, 1, 0, 0, 0;
-
- # Reverse
- my @parts = split /\./, $name;
- if ($t eq $DNS_TYPES->{PTR}) {
-
- # IPv4
- if ($ipv4) { @parts = reverse 'arpa', 'in-addr', @parts }
-
- # IPv6
- elsif ($ipv6) {
- @parts = reverse 'arpa', 'ip6', split //, unpack 'H32',
- inet_pton(IPV6_AF_INET6, $name);
- }
- }
-
- # Query (Internet)
- for my $part (@parts) {
- $req .= pack 'C/a*', $part if defined $part;
- }
- $req .= pack 'Cnn', 0, $t, 0x0001;
- $loop->write($id => $req);
- },
- on_error => sub {
- my ($loop, $id) = @_;
- warn "FAILED $type $name ($server)\n" if DEBUG;
- $CURRENT_SERVER++;
- $loop->drop($timer) if $timer;
- $self->$cb([]);
- },
- on_read => sub {
- my ($loop, $id, $chunk) = @_;
-
- # Cleanup
- $loop->drop($id);
- $loop->drop($timer) if $timer;
-
- # Check answers
- my @packet = unpack 'nnnnnna*', $chunk;
- warn "ANSWERS $packet[3] ($server)\n" if DEBUG;
- return $self->$cb([]) unless $packet[0] eq $tx;
-
- # Questions
- my $content = $packet[6];
- for (1 .. $packet[2]) {
- my $n;
- do { ($n, $content) = unpack 'C/aa*', $content } while ($n ne '');
- $content = (unpack 'nna*', $content)[2];
- }
-
- # Answers
- my @answers;
- for (1 .. $packet[3]) {
-
- # Parse
- (my ($t, $ttl, $a), $content) =
- (unpack 'nnnNn/aa*', $content)[1, 3, 4, 5];
- my @answer = _parse_answer($t, $a, $chunk, $content);
-
- # No answer
- next unless @answer;
-
- # Answer
- push @answers, [@answer, $ttl];
- warn "ANSWER $answer[0] $answer[1]\n" if DEBUG;
- }
- $self->$cb(\@answers);
- }
- );
-
- # Timer
- $timer = $loop->timer(
- $self->timeout => sub {
- my $loop = shift;
- warn "RESOLVE TIMEOUT ($server)\n" if DEBUG;
-
- # Abort
- $CURRENT_SERVER++;
- $loop->drop($id);
- $self->$cb([]);
- }
- );
-
- return $self;
-}
-
-# "I wonder where Bart is, his dinner's getting all cold... and eaten."
-sub servers {
- my $self = shift;
-
- # New servers
- if (@_) {
- @$SERVERS = @_;
- $CURRENT_SERVER = 0;
- return $self;
- }
-
- # List all
- return @$SERVERS if wantarray;
-
- # Current server
- $CURRENT_SERVER = 0 unless $SERVERS->[$CURRENT_SERVER];
- return $SERVERS->[$CURRENT_SERVER];
-}
-
-# Answer helper for "resolve"
-sub _parse_answer {
- my ($t, $a, $packet, $rest) = @_;
-
- # A
- if ($t eq $DNS_TYPES->{A}) { return A => join('.', unpack 'C4', $a) }
-
- # AAAA
- elsif ($t eq $DNS_TYPES->{AAAA}) {
- return AAAA => sprintf('%x:%x:%x:%x:%x:%x:%x:%x', unpack('n*', $a));
- }
-
- # TXT
- elsif ($t eq $DNS_TYPES->{TXT}) { return TXT => unpack('(C/a*)*', $a) }
-
- # Offset
- my $offset = length($packet) - length($rest) - length($a);
-
- # CNAME
- my $type;
- if ($t eq $DNS_TYPES->{CNAME}) { $type = 'CNAME' }
-
- # MX
- elsif ($t eq $DNS_TYPES->{MX}) {
- $type = 'MX';
- $offset += 2;
- }
-
- # NS
- elsif ($t eq $DNS_TYPES->{NS}) { $type = 'NS' }
-
- # PTR
- elsif ($t eq $DNS_TYPES->{PTR}) { $type = 'PTR' }
-
- # Domain name
- return $type => _parse_name($packet, $offset) if $type;
-
- # Not supported
- return;
-}
-
-# Domain name helper for "resolve"
-sub _parse_name {
- my ($packet, $offset) = @_;
-
- # Elements
- my @elements;
- for (1 .. 128) {
-
- # Element length
- my $len = ord substr $packet, $offset++, 1;
-
- # Offset
- if ($len >= 0xc0) {
- $offset = (unpack 'n', substr $packet, ++$offset - 2, 2) & 0x3fff;
- }
-
- # Element
- elsif ($len) {
- push @elements, substr $packet, $offset, $len;
- $offset += $len;
- }
-
- # Zero length element (the end)
- else { return join '.', @elements }
- }
-
- return;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Mojo::Resolver - Async IO DNS Resolver
-
-=head1 SYNOPSIS
-
- use Mojo::Resolver;
-
-=head1 DESCRIPTION
-
-L<Mojo::Resolver> is a minimalistic async io stub resolver.
-Note that this module is EXPERIMENTAL and might change without warning!
-
-=head1 ATTRIBUTES
-
-L<Mojo::Resolver> implements the following attributes.
-
-=head2 C<ioloop>
-
- my $ioloop = $resolver->ioloop;
- $resolver = $resolver->ioloop(Mojo::IOLoop->new);
-
-Loop object to use for io operations, by default a L<Mojo::IOLoop> object
-will be used.
-
-=head2 C<timeout>
-
- my $timeout = $resolver->timeout;
- $resolver = $resolver->timeout(5);
-
-Maximum time in seconds a C<DNS> lookup can take, defaults to C<3>.
-
-=head1 METHODS
-
-L<Mojo::Resolver> inherits all methods from L<Mojo::Base> and implements the
-following new ones.
-
-=head2 C<servers>
-
- my @all = $resolver->servers;
- my $current = $resolver->servers;
- $resolver = $resolver->servers('8.8.8.8', '8.8.4.4');
-
-IP addresses of C<DNS> servers used for lookups, defaults to the value of
-C<MOJO_DNS_SERVER>, auto detection, C<8.8.8.8> or C<8.8.4.4>.
-
-=head2 C<lookup>
-
- $resolver = $resolver->lookup('mojolicio.us' => sub {...});
-
-Lookup C<IPv4> or C<IPv6> address for domain.
-
- $resolver->lookup('mojolicio.us' => sub {
- my ($loop, $address) = @_;
- print "Address: $address\n";
- Mojo::IOLoop->stop;
- });
- Mojo::IOLoop->start;
-
-=head2 C<resolve>
-
- $resolver = $resolver->resolve('mojolicio.us', 'A', sub {...});
-
-Resolve domain into C<A>, C<AAAA>, C<CNAME>, C<MX>, C<NS>, C<PTR> or C<TXT>
-records, C<*> will query for all at once.
-Since this is a "stub resolver" it depends on a recursive name server for DNS
-resolution.
-
-=head1 DEBUGGING
-
-You can set the C<MOJO_RESOLVER_DEBUG> environment variable to get some
-advanced diagnostics information printed to C<STDERR>.
-
- MOJO_RESOLVER_DEBUG=1
-
-=head1 SEE ALSO
-
-L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>.
-
-=cut
@@ -234,23 +234,16 @@ sub _listen {
my ($self, $listen) = @_;
return unless $listen;
- # UNIX domain socket
+ # Check listen value
+ croak qq/Invalid listen value "$listen"/ unless $listen =~ $SOCKET_RE;
my $options = {};
my $tls;
- if ($listen =~ /^file\:\/\/(.+)$/) { unlink $options->{file} = $1 }
-
- # Internet socket
- elsif ($listen =~ $SOCKET_RE) {
- $tls = $options->{tls} = 1 if $1 eq 'https';
- $options->{address} = $2 if $2 ne '*';
- $options->{port} = $3;
- $options->{tls_cert} = $4 if $4;
- $options->{tls_key} = $5 if $5;
- $options->{tls_ca} = $6 if $6;
- }
-
- # Invalid
- else { croak qq/Invalid listen value "$listen"/ }
+ $tls = $options->{tls} = 1 if $1 eq 'https';
+ $options->{address} = $2 if $2 ne '*';
+ $options->{port} = $3;
+ $options->{tls_cert} = $4 if $4;
+ $options->{tls_key} = $5 if $5;
+ $options->{tls_ca} = $6 if $6;
# Listen backlog size
my $backlog = $self->backlog;
@@ -368,7 +361,7 @@ __END__
=head1 NAME
-Mojo::Server::Daemon - Async IO HTTP 1.1 And WebSocket Server
+Mojo::Server::Daemon - Async I/O HTTP 1.1 And WebSocket Server
=head1 SYNOPSIS
@@ -394,12 +387,12 @@ Mojo::Server::Daemon - Async IO HTTP 1.1 And WebSocket Server
=head1 DESCRIPTION
-L<Mojo::Server::Daemon> is a full featured async io HTTP 1.1 and WebSocket
-server with C<IPv6>, C<TLS>, C<Bonjour>, C<epoll> and C<kqueue> support.
+L<Mojo::Server::Daemon> is a full featured async I/O HTTP 1.1 and WebSocket
+server with C<IPv6>, C<TLS>, C<Bonjour> and C<libev> support.
-Optional modules L<IO::KQueue>, L<IO::Epoll>, L<IO::Socket::IP>,
-L<IO::Socket::SSL> and L<Net::Rendezvous::Publish> are supported
-transparently and used if installed.
+Optional modules L<EV>, L<IO::Socket::IP>, L<IO::Socket::SSL> and
+L<Net::Rendezvous::Publish> are supported transparently and used if
+installed.
See L<Mojolicious::Guides::Cookbook> for deployment recipes.
@@ -427,7 +420,7 @@ Group for server process.
my $loop = $daemon->ioloop;
$daemon = $daemon->ioloop(Mojo::IOLoop->new);
-Event loop for server IO, defaults to the global L<Mojo::IOLoop> singleton.
+Event loop for server I/O, defaults to the global L<Mojo::IOLoop> singleton.
=head2 C<keep_alive_timeout>
@@ -442,7 +435,7 @@ dropped, defaults to C<5>.
my $listen = $daemon->listen;
$daemon = $daemon->listen(['https://localhost:3000']);
-List of ports and files to listen on, defaults to C<http://*:3000>.
+List of one or more locations to listen on, defaults to C<http://*:3000>.
# Listen on two ports with HTTP and HTTPS at the same time
$daemon->listen(['http://*:3000', 'https://*:4000']);
@@ -417,25 +417,25 @@ Mojo::Server::Hypnotoad - ALL GLORY TO THE HYPNOTOAD!
L<Mojo::Server::Hypnotoad> is a full featured UNIX optimized preforking async
io HTTP 1.1 and WebSocket server built around the very well tested and
-reliable L<Mojo::Server::Daemon> with C<IPv6>, C<TLS>, C<Bonjour>, C<epoll>,
-C<kqueue> and hot deployment support that just works.
+reliable L<Mojo::Server::Daemon> with C<IPv6>, C<TLS>, C<Bonjour>, C<libev>
+and hot deployment support that just works.
To start applications with it you can use the L<hypnotoad> script.
- % hypnotoad myapp.pl
+ $ hypnotoad myapp.pl
Server available at http://127.0.0.1:8080.
You can run the exact same command again for automatic hot deployment.
- % hypnotoad myapp.pl
+ $ hypnotoad myapp.pl
Starting hot deployment for Hypnotoad server 31841.
For L<Mojolicious> and L<Mojolicious::Lite> applications it will default to
C<production> mode.
-Optional modules L<IO::KQueue>, L<IO::Epoll>, L<IO::Socket::IP>,
-L<IO::Socket::SSL> and L<Net::Rendezvous::Publish> are supported
-transparently and used if installed.
+Optional modules L<EV>, L<IO::Socket::IP>, L<IO::Socket::SSL> and
+L<Net::Rendezvous::Publish> are supported transparently and used if
+installed.
See L<Mojolicious::Guides::Cookbook> for deployment recipes.
@@ -572,7 +572,7 @@ dropped, defaults to C<5>.
listen => ['http://*:80']
-List of ports and files to listen on, defaults to C<http://*:8080>.
+List of one or more locations to listen on, defaults to C<http://*:8080>.
=head2 C<lock_file>
@@ -592,7 +592,7 @@ the application.
proxy => 1
Activate reverse proxy support, defaults to the value of
-C<MOJO_REVERSE_PROXY>.
+the C<MOJO_REVERSE_PROXY> environment variable.
=head2 C<upgrade_timeout>
@@ -138,19 +138,19 @@ Mojo::Server::Morbo - DOOOOOOOOOOOOOOOOOOM!
=head1 DESCRIPTION
-L<Mojo::Server::Morbo> is a full featured self-restart capable async io HTTP
+L<Mojo::Server::Morbo> is a full featured self-restart capable async I/O HTTP
1.1 and WebSocket server built around the very well tested and reliable
-L<Mojo::Server::Daemon> with C<IPv6>, C<TLS>, C<Bonjour>, C<epoll> and
-C<kqueue> support.
+L<Mojo::Server::Daemon> with C<IPv6>, C<TLS>, C<Bonjour> and C<libev>
+support.
To start applications with it you can use the L<morbo> script.
- % morbo myapp.pl
+ $ morbo myapp.pl
Server available at http://127.0.0.1:3000.
-Optional modules L<IO::KQueue>, L<IO::Epoll>, L<IO::Socket::IP>,
-L<IO::Socket::SSL> and L<Net::Rendezvous::Publish> are supported
-transparently and used if installed.
+Optional modules L<EV>, L<IO::Socket::IP>, L<IO::Socket::SSL> and
+L<Net::Rendezvous::Publish> are supported transparently and used if
+installed.
Note that this module is EXPERIMENTAL and might change without warning!
@@ -163,7 +163,7 @@ L<Mojo::Server::Morbo> implements the following attributes.
my $listen = $morbo->listen;
$morbo = $morbo->listen(['http://*:3000']);
-List of ports and files to listen on, defaults to C<http://*:3000>.
+List of one or more locations to listen on, defaults to C<http://*:3000>.
=head2 C<watch>
@@ -177,7 +177,7 @@ sub interpret {
return unless $compiled;
# Stacktrace
- local $SIG{__DIE__} = local $SIG{__DIE__} = sub {
+ local $SIG{__DIE__} = sub {
CORE::die($_[0]) if ref $_[0];
Mojo::Exception->throw(shift, [$self->template, $self->code],
$self->name);
@@ -416,14 +416,14 @@ Callback to be invoked for requests.
my $req = $tx->req;
$tx = $tx->req(Mojo::Message::Request->new);
-HTTP 1.1 request, by default a L<Mojo::Message::Request> object.
+HTTP 1.1 request, defaults to a L<Mojo::Message::Request> object.
=head2 C<res>
my $res = $tx->res;
$tx = $tx->res(Mojo::Message::Response->new);
-HTTP 1.1 response, by default a L<Mojo::Message::Response> object.
+HTTP 1.1 response, defaults to a L<Mojo::Message::Response> object.
=head1 METHODS
@@ -17,26 +17,6 @@ our $UNRESERVED = 'A-Za-z0-9\-\.\_\~';
our $SUBDELIM = '!\$\&\'\(\)\*\+\,\;\=';
our $PCHAR = "$UNRESERVED$SUBDELIM\%\:\@";
-# IPv4 regex (RFC 3986)
-my $DEC_OCTET_RE = qr/(?:[0-9]|[1-9][0-9]|1[0-9][0-9]|2[0-4][0-9]|25[0-5])/;
-our $IPV4_RE =
- qr/^$DEC_OCTET_RE\.$DEC_OCTET_RE\.$DEC_OCTET_RE\.$DEC_OCTET_RE$/;
-
-# IPv6 regex (RFC 3986)
-my $H16_RE = qr/[0-9A-Fa-f]{1,4}/;
-my $LS32_RE = qr/(?:$H16_RE:$H16_RE|$IPV4_RE)/;
-our $IPV6_RE = qr/(?:
- (?: $H16_RE : ){6} $LS32_RE
- | :: (?: $H16_RE : ){5} $LS32_RE
- | (?: $H16_RE )? :: (?: $H16_RE : ){4} $LS32_RE
- | (?: (?: $H16_RE : ){0,1} $H16_RE )? :: (?: $H16_RE : ){3} $LS32_RE
- | (?: (?: $H16_RE : ){0,2} $H16_RE )? :: (?: $H16_RE : ){2} $LS32_RE
- | (?: (?: $H16_RE : ){0,3} $H16_RE )? :: $H16_RE : $LS32_RE
- | (?: (?: $H16_RE : ){0,4} $H16_RE )? :: $LS32_RE
- | (?: (?: $H16_RE : ){0,5} $H16_RE )? :: $H16_RE
- | (?: (?: $H16_RE : ){0,6} $H16_RE )? ::
-)/x;
-
sub new {
my $self = shift->SUPER::new();
$self->parse(@_);
@@ -147,16 +127,6 @@ sub is_abs {
return;
}
-sub is_ipv4 {
- return 1 if shift->host =~ $IPV4_RE;
- return;
-}
-
-sub is_ipv6 {
- return 1 if shift->host =~ $IPV6_RE;
- return;
-}
-
sub parse {
my ($self, $url) = @_;
return $self unless $url;
@@ -467,20 +437,6 @@ Host part of this URL in punycode format.
Check if URL is absolute.
-=head2 C<is_ipv4>
-
- my $is_ipv4 = $url->is_ipv4;
-
-Check if C<host> is an C<IPv4> address.
-Note that this method is EXPERIMENTAL and might change without warning!
-
-=head2 C<is_ipv6>
-
- my $is_ipv6 = $url->is_ipv6;
-
-Check if C<host> is an C<IPv6> address.
-Note that this method is EXPERIMENTAL and might change without warning!
-
=head2 C<parse>
$url = $url->parse('http://127.0.0.1:3000/foo/bar?fo=o&baz=23#foo');
@@ -319,8 +319,6 @@ sub _error {
$self->_handle($id, $error);
}
-# "Oh, I'm in no condition to drive. Wait a minute.
-# I don't have to listen to myself. I'm drunk."
sub _finish {
my ($self, $tx, $cb, $close) = @_;
@@ -399,15 +397,9 @@ sub _proxy_connect {
# TLS upgrade
if ($tx->req->url->scheme eq 'https') {
-
- # Connection from keep alive cache
- return unless my $old_id = $tx->connection;
-
- # Start TLS
- my $new_id = $self->{loop}->start_tls($old_id);
+ return unless my $id = $tx->connection;
+ $self->{loop}->start_tls($id);
$old->req->proxy(undef);
- delete $self->{cs}->{$old_id};
- $tx->connection($new_id);
}
# Share connection and start real transaction
@@ -427,13 +419,9 @@ sub _read {
return unless my $c = $self->{cs}->{$id};
return $self->_drop($id) unless my $tx = $c->{tx};
- # Read
+ # Process incoming data
$tx->client_read($chunk);
-
- # Finish
- if ($tx->is_done) { $self->_handle($id) }
-
- # Write
+ if ($tx->is_done) { $self->_handle($id) }
elsif ($c->{tx}->is_writing) { $self->_write($id) }
}
@@ -546,6 +534,7 @@ sub _test_server {
$self->{scheme} = $scheme ||= 'http';
$server->listen(["$scheme://*:$port"]);
$server->prepare_ioloop;
+ warn "TEST SERVER STARTED ($scheme://*:$port)\n" if DEBUG;
}
return $self->{server};
@@ -580,24 +569,22 @@ sub _upgrade {
sub _write {
my ($self, $id) = @_;
- # Get chunk
+ # Prepare outgoing data
return unless my $c = $self->{cs}->{$id};
return unless my $tx = $c->{tx};
return unless $tx->is_writing;
my $chunk = $tx->client_write;
- # More to write
+ # More data to follow
my $cb;
if ($tx->is_writing) {
weaken $self;
$cb = sub { $self->_write($id) };
}
- # Write
+ # Write data
$self->{loop}->write($id, $chunk, $cb);
- warn "> $chunk\n" if DEBUG;
-
- # Finish
+ warn "> $chunk\n" if DEBUG;
$self->_handle($id) if $tx->is_done;
}
@@ -606,7 +593,7 @@ __END__
=head1 NAME
-Mojo::UserAgent - Async IO HTTP 1.1 And WebSocket User Agent
+Mojo::UserAgent - Async I/O HTTP 1.1 And WebSocket User Agent
=head1 SYNOPSIS
@@ -627,7 +614,7 @@ Mojo::UserAgent - Async IO HTTP 1.1 And WebSocket User Agent
# Scrape the latest headlines from a news site
my $news = 'http://digg.com';
$ua->max_redirects(3);
- $ua->get($news)->res->dom('h3.story-item-title > a[href]')->each(
+ $ua->get($news)->res->dom('h3.story-item-title > a[href]')->each(sub {
my $e = shift;
print "$e->{href}:\n";
print $e->text, "\n";
@@ -661,11 +648,11 @@ Mojo::UserAgent - Async IO HTTP 1.1 And WebSocket User Agent
=head1 DESCRIPTION
-L<Mojo::UserAgent> is a full featured async io HTTP 1.1 and WebSocket user
-agent with C<IPv6>, C<TLS>, C<epoll> and C<kqueue> support.
+L<Mojo::UserAgent> is a full featured async I/O HTTP 1.1 and WebSocket user
+agent with C<IPv6>, C<TLS> and C<libev> support.
-Optional modules L<IO::KQueue>, L<IO::Epoll>, L<IO::Socket::IP> and
-L<IO::Socket::SSL> are supported transparently and used if installed.
+Optional modules L<EV>, L<IO::Socket::IP> and L<IO::Socket::SSL> are
+supported transparently and used if installed.
=head1 ATTRIBUTES
@@ -676,14 +663,15 @@ L<Mojo::UserAgent> implements the following attributes.
my $cert = $ua->cert;
$ua = $ua->cert('tls.crt');
-Path to TLS certificate file, defaults to the value of C<MOJO_CERT_FILE>.
+Path to TLS certificate file, defaults to the value of the C<MOJO_CERT_FILE>
+environment variable.
=head2 C<cookie_jar>
my $cookie_jar = $ua->cookie_jar;
$ua = $ua->cookie_jar(Mojo::CookieJar->new);
-Cookie jar to use for this user agents requests, by default a
+Cookie jar to use for this user agents requests, defaults to a
L<Mojo::CookieJar> object.
=head2 C<http_proxy>
@@ -705,8 +693,8 @@ Proxy server to use for HTTPS and WebSocket requests.
my $loop = $ua->ioloop;
$ua = $ua->ioloop(Mojo::IOLoop->new);
-Loop object to use for blocking io operations, by default a L<Mojo::IOLoop>
-object will be used.
+Loop object to use for blocking I/O operations, defaults to a L<Mojo::IOLoop>
+object.
=head2 C<keep_alive_timeout>
@@ -721,15 +709,16 @@ dropped, defaults to C<15>.
my $key = $ua->key;
$ua = $ua->key('tls.crt');
-Path to TLS key file, defaults to the value of C<MOJO_KEY_FILE>.
+Path to TLS key file, defaults to the value of the C<MOJO_KEY_FILE>
+environment variable.
=head2 C<log>
my $log = $ua->log;
$ua = $ua->log(Mojo::Log->new);
-A L<Mojo::Log> object used for logging, by default the application log will
-be used.
+A L<Mojo::Log> object used for logging, defaults to the application log or a
+L<Mojo::Log> object.
=head2 C<max_connections>
@@ -745,7 +734,8 @@ before it starts closing the oldest cached ones, defaults to C<5>.
$ua = $ua->max_redirects(3);
Maximum number of redirects the user agent will follow before it fails,
-defaults to the value of C<MOJO_MAX_REDIRECTS> or C<0>.
+defaults to the value of the C<MOJO_MAX_REDIRECTS> environment variable or
+C<0>.
=head2 C<name>
@@ -781,7 +771,7 @@ redirects.
my $t = $ua->transactor;
$ua = $ua->transactor(Mojo::UserAgent::Transactor->new);
-Transaction builder, by default a L<Mojo::UserAgent::Transactor> object.
+Transaction builder, defaults to a L<Mojo::UserAgent::Transactor> object.
Note that this attribute is EXPERIMENTAL and might change without warning!
=head2 C<websocket_timeout>
@@ -804,7 +794,7 @@ following new ones.
$ua = $ua->app(MyApp->new);
Application relative URLs will be processed with, defaults to the value of
-C<MOJO_APP>.
+the C<MOJO_APP> environment variable.
print $ua->app->secret;
$ua->app->log->level('fatal');
@@ -90,7 +90,7 @@ L<Mojo> implements the following attributes.
my $home = $app->home;
$app = $app->home(Mojo::Home->new);
-The home directory of your application, by default a L<Mojo::Home> object
+The home directory of your application, defaults to a L<Mojo::Home> object
which stringifies to the actual path.
=head2 C<log>
@@ -98,14 +98,14 @@ which stringifies to the actual path.
my $log = $app->log;
$app = $app->log(Mojo::Log->new);
-The logging layer of your application, by default a L<Mojo::Log> object.
+The logging layer of your application, defaults to a L<Mojo::Log> object.
=head2 C<on_transaction>
my $cb = $app->on_transaction;
$app = $app->on_transaction(sub {...});
-Callback to be invoked when a new transaction is needed, by default it builds
+Callback to be invoked when a new transaction is needed, defaults to building
a L<Mojo::Transaction::HTTP> object.
=head2 C<on_websocket>
@@ -113,7 +113,7 @@ a L<Mojo::Transaction::HTTP> object.
my $cb = $app->on_websocket;
$app = $app->on_websocket(sub {...});
-Callback to be invoked for WebSocket handshakes, by default it builds a
+Callback to be invoked for WebSocket handshakes, defaults to building a
L<Mojo::Transaction::WebSocket> object and handles the response for the
handshake request.
@@ -122,7 +122,7 @@ handshake request.
my $ua = $app->ua;
$app = $app->ua(Mojo::UserAgent->new);
-A full featured HTTP 1.1 user agent for use in your applications, by default
+A full featured HTTP 1.1 user agent for use in your applications, defaults to
a L<Mojo::UserAgent> object.
=head1 METHODS
@@ -30,7 +30,7 @@ sub run {
local @ARGV = @_ if @_;
my $verbose;
- GetOptions('verbose' => sub { $verbose = 1 });
+ GetOptions(verbose => sub { $verbose = 1 });
my $code = shift @ARGV || '';
# Run code against application
@@ -28,7 +28,7 @@ __DATA__
blib
Makefile*
!Makefile.PL
-*META.yml
+*META.*
MANIFEST*
!MANIFEST.SKIP
pm_to_blib
@@ -51,8 +51,8 @@ sub run {
'content=s' => sub { $content = $_[1] },
'header=s' => \@headers,
'method=s' => sub { $method = $_[1] },
- 'redirect' => sub { $redirect = 1 },
- 'verbose' => sub { $verbose = 1 }
+ redirect => sub { $redirect = 1 },
+ verbose => sub { $verbose = 1 }
);
# Headers
@@ -163,7 +163,7 @@ sub _select {
# Commands
my $done = 0;
- while (my $command = shift @ARGV) {
+ while (defined(my $command = shift @ARGV)) {
# Number
if ($command =~ /^\d+$/) {
@@ -1,7 +1,7 @@
package Mojolicious::Command::Version;
use Mojo::Base 'Mojo::Command';
-use Mojo::IOLoop;
+use Mojo::IOLoop::Server;
use Mojo::Server::Daemon;
use Mojo::UserAgent;
use Mojolicious;
@@ -34,19 +34,16 @@ sub run {
$message = "You might want to update your Mojolicious to $latest."
if $latest > $current;
- # Epoll
- my $epoll = Mojo::IOLoop::EPOLL() ? $IO::Epoll::VERSION : 'not installed';
-
- # KQueue
- my $kqueue =
- Mojo::IOLoop::KQUEUE() ? $IO::KQueue::VERSION : 'not installed';
+ # EV
+ my $ev = eval 'use Mojo::IOWatcher::EV; 1' ? $EV::VERSION : 'not installed';
# IPv6
my $ipv6 =
- Mojo::IOLoop::IPV6() ? $IO::Socket::IP::VERSION : 'not installed';
+ Mojo::IOLoop::Server::IPV6() ? $IO::Socket::IP::VERSION : 'not installed';
# TLS
- my $tls = Mojo::IOLoop::TLS() ? $IO::Socket::SSL::VERSION : 'not installed';
+ my $tls =
+ Mojo::IOLoop::Server::TLS() ? $IO::Socket::SSL::VERSION : 'not installed';
# Bonjour
my $bonjour =
@@ -60,8 +57,7 @@ CORE
Mojolicious ($Mojolicious::VERSION, $Mojolicious::CODENAME)
OPTIONAL
- IO::Epoll ($epoll)
- IO::KQueue ($kqueue)
+ EV ($ev)
IO::Socket::IP ($ipv6)
IO::Socket::SSL ($tls)
Net::Rendezvous::Publish ($bonjour)
@@ -55,116 +55,116 @@ These commands are available by default.
=head2 C<help>
- % mojo
- % mojo help
+ $ mojo
+ $ mojo help
List available commands with short descriptions.
- % mojo help <command>
+ $ mojo help <command>
List available options for the command with short descriptions.
=head2 C<cgi>
- % mojo cgi
- % script/myapp cgi
+ $ mojo cgi
+ $ script/myapp cgi
Start application with CGI backend.
=head2 C<daemon>
- % mojo daemon
- % script/myapp daemon
+ $ mojo daemon
+ $ script/myapp daemon
Start application with standalone HTTP 1.1 server backend.
=head2 C<eval>
- % mojo eval 'print app->home'
- % script/myapp eval 'print app->home'
+ $ mojo eval 'print app->home'
+ $ script/myapp eval 'print app->home'
Run code against application.
=head2 C<fastcgi>
- % mojo fastcgi
- % script/myapp fastcgi
+ $ mojo fastcgi
+ $ script/myapp fastcgi
Start application with FastCGI backend.
=head2 C<generate>
- % mojo generate
- % mojo generate help
+ $ mojo generate
+ $ mojo generate help
List available generator commands with short descriptions.
- % mojo generate help <generator>
+ $ mojo generate help <generator>
List available options for generator command with short descriptions.
=head2 C<generate app>
- % mojo generate app <AppName>
+ $ mojo generate app <AppName>
Generate application directory structure for a fully functional
L<Mojolicious> application.
=head2 C<generate gitignore>
- % mojo generate gitignore
+ $ mojo generate gitignore
Generate C<.gitignore> file.
=head2 C<generate hypnotoad>
- % mojo generate hypnotoad
+ $ mojo generate hypnotoad
Generate C<hypnotoad.conf> file.
=head2 C<generate lite_app>
- % mojo generate lite_app
+ $ mojo generate lite_app
Generate a fully functional L<Mojolicious::Lite> application.
=head2 C<generate makefile>
- % mojo generate makefile
+ $ mojo generate makefile
Generate C<Makefile.PL> file for application.
=head2 C<get>
- % mojo get http://mojolicio.us
- % script/myapp get /foo
+ $ mojo get http://mojolicio.us
+ $ script/myapp get /foo
Perform GET request to remote host or local application.
=head2 C<inflate>
- % myapp.pl inflate
+ $ myapp.pl inflate
Turn embedded files from the C<DATA> section into real files.
=head2 C<routes>
- % myapp.pl routes
- % script/myapp routes
+ $ myapp.pl routes
+ $ script/myapp routes
List application routes.
=head2 C<test>
- % mojo test
- % script/myapp test
- % script/myapp test t/foo.t
+ $ mojo test
+ $ script/myapp test
+ $ script/myapp test t/foo.t
Runs application tests from the C<t> directory.
=head2 C<version>
- % mojo version
+ $ mojo version
List version information for installed core and optional modules, very useful
for debugging.
@@ -935,7 +935,7 @@ connection in progress.
$c = $c->session({foo => 'bar'});
$c = $c->session(foo => 'bar');
-Persistent data storage, by default stored in a signed cookie.
+Persistent data storage, defaults to using signed cookies.
Note that cookies are generally limited to 4096 bytes of data.
$c->session->{foo} = 'bar';
@@ -164,8 +164,8 @@ Note that L<IO::Socket::SSL> must be installed for TLS support.
=head2 C<MOJO_CHUNK_SIZE>
-Chunk size used for IO operations in bytes, a bigger chunk size speeds up IO
-operations but will also use more memory, defaults to C<131072>.
+Chunk size used for I/O operations in bytes, a bigger chunk size speeds up
+I/O operations but will also use more memory, defaults to C<131072>.
MOJO_CHUNK_SIZE=1024
@@ -189,6 +189,12 @@ path like C</home/sri/myapp>.
MOJO_HOME=/home/sri/myapp
+=head2 C<MOJO_IOWATCHER>
+
+Alternative L<Mojo::IOWatcher> implementation to try.
+
+ MOJO_IOWATCHER=Mojo::IOWatcher::EV
+
=head2 C<MOJO_KEY_FILE>
The path to the TLS key, should always contain a path like
@@ -273,13 +279,6 @@ Note that L<IO::Socket::SSL> must be installed for TLS support.
MOJO_NO_TLS=1
-=head2 C<MOJO_POLL>
-
-Force poll mainloop for IO operations, this should only be used for testing
-since other mainloops are generally faster and scale better.
-
- MOJO_POLL=1
-
=head2 C<MOJO_PROXY>
Enable automatic HTTP and HTTPS proxy detection in L<Mojo::UserAgent>, for
@@ -311,8 +310,8 @@ defaults to C<main>.
=head2 C<MOJO_TMPDIR>
-Directory for temporary files like huge uploads, by default a random platform
-specific temporary directory will be used.
+Directory for temporary files like huge uploads, defaults to using a random
+platform specific temporary directory.
MOJO_TMPDIR=/tmp/mojo
@@ -18,18 +18,18 @@ L<Mojolicious> contains a very portable HTTP 1.1 compliant web server.
It is usually used during development but is solid and fast enough for small
to mid sized applications.
- % ./script/myapp daemon
+ $ ./script/myapp daemon
Server available at http://127.0.0.1:3000.
It has many configuration options and is known to work on every platform
Perl works on.
- % ./script/myapp help daemon
+ $ ./script/myapp help daemon
...List of available options...
Another huge advantage is that it supports TLS and WebSockets out of the box.
- % ./script/myapp daemon --listen https://*:3000
+ $ ./script/myapp daemon --listen https://*:3000
Server available at https://127.0.0.1:3000.
A development certificate for testing purposes is built right in, so it just
@@ -50,7 +50,7 @@ of multiple cpu cores and copy-on-write.
It is based on the normal built-in web server but optimized specifically for
production environments out of the box.
- % hypnotoad script/myapp
+ $ hypnotoad script/myapp
Server available at http://127.0.0.1:8080.
Config files are plain Perl scripts for maximal customizability.
@@ -64,7 +64,7 @@ That means you can upgrade L<Mojolicious>, Perl or even system libraries at
runtime without ever stopping the server or losing a single incoming
connection, just by running the command above again.
- % hypnotoad script/myapp
+ $ hypnotoad script/myapp
Starting hot deployment for Hypnotoad server 31841.
=head2 Nginx
@@ -118,7 +118,7 @@ and adapters to web servers.
L<PSGI> and L<Plack> are inspired by Python's WSGI and Ruby's Rack.
L<Mojolicious> applications are ridiculously simple to deploy with L<Plack>.
- % plackup ./script/myapp
+ $ plackup ./script/myapp
HTTP::Server::PSGI: Accepting connections at http://0:5000/
L<Plack> provides many server and protocol adapters for you to choose from
@@ -126,7 +126,7 @@ such as C<FCGI>, C<SCGI> and C<mod_perl>.
Make sure to run C<plackup> from your applications home directory, otherwise
libraries might not be found.
- % plackup ./script/myapp -s FCGI -l /tmp/myapp.sock
+ $ plackup ./script/myapp -s FCGI -l /tmp/myapp.sock
Because C<plackup> uses a weird trick to load your script, L<Mojolicious> is
not always able to detect the applications home directory, if that's the case
@@ -134,7 +134,7 @@ you can simply use the C<MOJO_HOME> environment variable.
Also note that C<app-E<gt>start> needs to be the last Perl statement in the
application script for the same reason.
- % MOJO_HOME=/home/sri/myapp plackup ./script/myapp
+ $ MOJO_HOME=/home/sri/myapp plackup ./script/myapp
HTTP::Server::PSGI: Accepting connections at http://0:5000/
Some server adapters might ask for a C<.psgi> file, if that's the case you
@@ -230,9 +230,9 @@ make sense for a standalone parser.
# Extract title
print 'Title: ', $tx->res->dom->at('head > title')->text, "\n";
- # Extract headers
+ # Extract headings
$tx->res->dom('h1, h2, h3')->each(sub {
- print 'Header: ', shift->all_text, "\n";
+ print 'Heading: ', shift->all_text, "\n";
});
Especially for unit testing your L<Mojolicious> applications this can be a
@@ -423,36 +423,36 @@ Thanks to the C<mojo get> command that is about to change.
You can just pick the parts that actually matter with the CSS3 selectors from
L<Mojo::DOM>.
- % mojo get http://mojolicio.us 'head > title'
+ $ mojo get http://mojolicio.us 'head > title'
How about a list of all id attributes?
- % mojo get http://mojolicio.us '*' attr id
+ $ mojo get http://mojolicio.us '*' attr id
-Or the text content of all header tags?
+Or the text content of all heading tags?
- % mojo get http://mojolicio.us 'h1, h2, h3' text
+ $ mojo get http://mojolicio.us 'h1, h2, h3' text
-Maybe just the text of the third header?
+Maybe just the text of the third heading?
- % mojo get http://mojolicio.us 'h1, h2, h3' 3 text
+ $ mojo get http://mojolicio.us 'h1, h2, h3' 3 text
You can also extract all text from nested child elements.
- % mojo get http://mojolicio.us '#mojobar' all
+ $ mojo get http://mojolicio.us '#mojobar' all
The request can be customized as well.
- % mojo get --method post --content 'Hello!' http://mojolicio.us
- % mojo get --header 'X-Bender: Bite my shiny metal ass!' http://google.com
+ $ mojo get --method post --content 'Hello!' http://mojolicio.us
+ $ mojo get --header 'X-Bender: Bite my shiny metal ass!' http://google.com
You can follow redirects and view the headers for all messages.
- % mojo get --redirect --verbose http://reddit.com 'head > title'
+ $ mojo get --redirect --verbose http://reddit.com 'head > title'
This can be an invaluable tool for testing your applications.
- % ./myapp.pl get /welcome 'head > title'
+ $ ./myapp.pl get /welcome 'head > title'
=head1 HACKS
@@ -464,7 +464,7 @@ Don't you hate waiting for C<make test> to finally finish?
In newer Perl versions you can set the C<HARNESS_OPTIONS> environment
variable to take advantage of multiple cpu cores and run tests parallel.
- % HARNESS_OPTIONS=j5 make test
+ $ HARNESS_OPTIONS=j5 make test
...
The C<j5> allows 5 tests to run at the same time, which makes for example the
@@ -477,22 +477,22 @@ application to test something?
Thanks to the C<eval> command you can do just that, the application instance
itself can be accessed via C<app>.
- % mojo generate lite_app
- % ./myapp.pl eval 'print app->static->root, "\n"'
+ $ mojo generate lite_app
+ $ ./myapp.pl eval 'print app->static->root, "\n"'
The C<verbose> option will automatically print the return value to C<STDOUT>.
- % ./myapp.pl eval -v 'app->static->root'
+ $ ./myapp.pl eval -v 'app->static->root'
=head2 Making Your Application Installable
Ever thought about releasing your L<Mojolicious> application to CPAN?
It's actually much easier than you might think.
- % mojo generate app
- % cd my_mojolicious_app
- % mv public lib/MyMojoliciousApp/
- % mv templates lib/MyMojoliciousApp/
+ $ mojo generate app
+ $ cd my_mojolicious_app
+ $ mv public lib/MyMojoliciousApp/
+ $ mv templates lib/MyMojoliciousApp/
The trick is to move the C<public> and C<templates> directories so they can
get automatically installed with the modules.
@@ -530,11 +530,11 @@ get automatically installed with the modules.
That's really everything, now you can package your application like any other
CPAN module.
- % ./script/my_mojolicious_app generate makefile
- % perl Makefile.PL
- % make test
- % make manifest
- % make dist
+ $ ./script/my_mojolicious_app generate makefile
+ $ perl Makefile.PL
+ $ make test
+ $ make manifest
+ $ make dist
=head2 Hello World
@@ -565,7 +565,7 @@ And you can use all the commands from L<Mojolicious::Commands>.
This tasty oneliner will keep your L<Mojolicious> as fresh as possible.
- sudo sh -c "curl -L cpanmin.us | perl - http://latest.mojolicio.us"
+ $ sudo sh -c "curl -L cpanmin.us | perl - http://latest.mojolicio.us"
=head2 jQuery (Content Distribution Network)
@@ -17,10 +17,9 @@ without compromises.
While there are no rules in L<Mojolicious::Guides::CodingGuidelines> that
forbid dependencies, we do currently discourage adding non-optional ones in
favor of a faster and more painless installation process.
-And we do in fact already use several optional CPAN modules such as
-L<IO::KQueue>, L<IO::Epoll>, L<IO::Socket::IP>, L<IO::Socket::SSL>,
-L<Net::Rendezvous::Publish> and L<Plack> to provide advanced functionality if
-they are installed.
+And we do in fact already use several optional CPAN modules such as L<EV>,
+L<IO::Socket::IP>, L<IO::Socket::SSL>, L<Net::Rendezvous::Publish> and
+L<Plack> to provide advanced functionality if they are installed.
=head2 Why reinvent wheels?
@@ -112,7 +111,7 @@ deploying L<Mojolicious> applications.
Quite possibly this oneliner.
- sudo sh -c "curl -L cpanmin.us | perl - Mojolicious"
+ $ sudo sh -c "curl -L cpanmin.us | perl - Mojolicious"
=head2 I think L<Mojolicious> is awesome, how can i support you guys?
@@ -165,17 +165,17 @@ organized CPAN distribution to maximize maintainability.
Both application skeletons can be automatically generated.
- % mojo generate lite_app
- % mojo generate app
+ $ mojo generate lite_app
+ $ mojo generate app
=head2 Foundation
We start our new application with a single executable Perl script.
- % mkdir myapp
- % cd myapp
- % touch myapp.pl
- % chmod 744 myapp.pl
+ $ mkdir myapp
+ $ cd myapp
+ $ touch myapp.pl
+ $ chmod 744 myapp.pl
This will be the foundation for our login manager example application.
@@ -192,7 +192,7 @@ This will be the foundation for our login manager example application.
The built-in development web server makes working on your application a lot
of fun thanks to automatic reloading.
- % morbo myapp.pl
+ $ morbo myapp.pl
Server available at http://127.0.0.1:3000.
Just save your changes and they will be automatically in effect the next time
@@ -204,9 +204,9 @@ In L<Mojolicious> we consider web applications simple frontends for existing
business logic, that means L<Mojolicious> is by design entirely L<model>
layer agnostic and you just use whatever Perl modules you like most.
- % mkdir lib
- % touch lib/MyUsers.pm
- % chmod 644 lib/MyUsers.pm
+ $ mkdir lib
+ $ touch lib/MyUsers.pm
+ $ chmod 644 lib/MyUsers.pm
Our login manager will simply use a plain old Perl module abstracting away
all logic related to matching user names and passwords.
@@ -277,9 +277,9 @@ access query parameters, POST parameters and route placeholders, all at once.
In L<Mojolicious> we take test driven development very serious and try to
promote it wherever we can.
- % mkdir t
- % touch t/login.t
- % chmod 644 t/login.t
+ $ mkdir t
+ $ touch t/login.t
+ $ chmod 644 t/login.t
L<Test::Mojo> is a scriptable HTTP user agent designed specifically for
testing, with many fun state of the art features such as CSS3 selectors based
@@ -317,8 +317,8 @@ on L<Mojo::DOM>.
From now on you can always check your progress by running these unit tests
against your application.
- % ./myapp.pl test
- % ./myapp.pl test t/login.t
+ $ ./myapp.pl test
+ $ ./myapp.pl test t/login.t
To make the tests less noisy and limit log output to just C<error> messages
you can also add a line like this.
@@ -327,10 +327,10 @@ you can also add a line like this.
Quick C<GET> requests can be performed right from the command line.
- % ./myapp.pl get /
+ $ ./myapp.pl get /
Wrong username or password!
- % ./myapp.pl get -v '/?user=sri&pass=secr3t'
+ $ ./myapp.pl get -v '/?user=sri&pass=secr3t'
HTTP/1.1 200 OK
Connection: Keep-Alive
Date: Sun, 18 Jul 2010 13:09:58 GMT
@@ -470,7 +470,7 @@ All templates and static files inlined in the C<DATA> section can be
automatically turned into separate files in the C<templates> and C<public>
directories.
- % ./myapp.pl inflate
+ $ ./myapp.pl inflate
Those directories always get priority, so inflating can also be a great way
to allow your users to customize their applications.
@@ -480,8 +480,8 @@ to allow your users to customize their applications.
This is the heart of every full L<Mojolicious> application and always gets
instantiated during server startup.
- % touch lib/MyApp.pm
- % chmod 644 lib/MyApp.pm
+ $ touch lib/MyApp.pm
+ $ chmod 644 lib/MyApp.pm
We will start by extracting all actions from C<myapp.pl> and turn them into
simplified hybrid routes in the L<Mojolicious::Routes> router, none of the
@@ -554,9 +554,9 @@ allow running unit tests again.
Hybrid routes are a nice intermediate step, but to maximize maintainability
it makes sense to split our action code from its routing information.
- % mkdir lib/MyApp
- % touch lib/MyApp/Login.pm
- % chmod 644 lib/MyApp/Login.pm
+ $ mkdir lib/MyApp
+ $ touch lib/MyApp/Login.pm
+ $ chmod 644 lib/MyApp/Login.pm
Once again the actual action code does not change at all.
@@ -625,18 +625,18 @@ most.
Templates are usually bound to controllers, so they need to be moved into the
appropriate directories.
- % mkdir templates/login
- % mv templates/index.html.ep templates/login/index.html.ep
- % mv templates/protected.html.ep templates/login/protected.html.ep
+ $ mkdir templates/login
+ $ mv templates/index.html.ep templates/login/index.html.ep
+ $ mv templates/protected.html.ep templates/login/protected.html.ep
=head2 Script
Finally C<myapp.pl> can be replaced with a proper L<Mojolicious> script.
- % rm myapp.pl
- % mkdir script
- % touch script/myapp
- % chmod 744 script/myapp
+ $ rm myapp.pl
+ $ mkdir script
+ $ touch script/myapp
+ $ chmod 744 script/myapp
The library detection code was specifically designed for tricky production
environments.
@@ -547,7 +547,7 @@ The C<inflate> command will write all templates and static files from the
C<DATA> section into actual files in the C<templates> and C<public>
directories.
- % ./myapp.pl inflate
+ $ ./myapp.pl inflate
=head2 Customizing The Template Syntax
@@ -102,8 +102,8 @@ all characters except C</> and C<.>.
/sebastian23/hello -> /:name/hello -> {name => 'sebastian23'}
/sebastian 23/hello -> /:name/hello -> {name => 'sebastian 23'}
-A generic placeholder can be surrounded by brackets to separate it from the
-surrounding text.
+A generic placeholder can be surrounded by parentheses to separate it from
+the surrounding text.
/hello -> /(:name)hello -> undef
/sebastian/23hello -> /(:name)hello -> undef
@@ -127,7 +127,7 @@ absolutely everything.
=head2 Relaxed Placeholders
Relaxed placeholders are similar to the two placeholders above, but always
-require brackets and match all characters except C</>.
+require parentheses and match all characters except C</>.
/hello -> /(.name)/hello -> undef
/sebastian/23/hello -> /(.name)/hello -> undef
@@ -788,7 +788,7 @@ snowman very sad.
The C<routes> command can be used from the command line to list all available
routes together with name and underlying regular expressions.
- % script/myapp routes
+ $ script/myapp routes
/foo/:name GET fooname (?-xism:^/foo/([^\/\.]+))
/baz/*everything POST bazeverything (?-xism:^/baz/(.+))
/bar/(.test) * bartest (?-xism:^/bar/([^\/]+))
@@ -70,7 +70,7 @@ ones.
=item L<Mojo::UserAgent>
-Full featured async io HTTP 1.1 and WebSocket user agent.
+Full featured async I/O HTTP 1.1 and WebSocket user agent.
=item L<Mojo::DOM>
@@ -82,12 +82,12 @@ Minimalistic JSON implementation that just works.
=item L<Mojo::Server::Daemon>
-Highly portable async io HTTP 1.1 and WebSocket server with self-restart
+Highly portable async I/O HTTP 1.1 and WebSocket server with self-restart
support through L<Mojo::Server::Morbo>, perfect for development and testing.
=item L<Mojo::Server::Hypnotoad>
-Full featured UNIX optimized preforking async io HTTP 1.1 and WebSocket
+Full featured UNIX optimized preforking async I/O HTTP 1.1 and WebSocket
server with support for zero downtime software upgrades (hot deployment).
=item L<Mojo::Server::CGI>, L<Mojo::Server::FastCGI>, L<Mojo::Server::PSGI>
@@ -120,7 +120,7 @@ application.
There is also a helper command to generate a small example application.
- % mojo generate lite_app
+ $ mojo generate lite_app
=head2 Commands
@@ -129,19 +129,19 @@ available from the command line.
Note that CGI, FastCGI and PSGI environments can usually be auto detected and
will just work without commands.
- % ./myapp.pl daemon
+ $ ./myapp.pl daemon
Server available at http://127.0.0.1:3000.
- % ./myapp.pl daemon --listen http://*:8080
+ $ ./myapp.pl daemon --listen http://*:8080
Server available at http://127.0.0.1:8080.
- % ./myapp.pl cgi
+ $ ./myapp.pl cgi
...CGI output...
- % ./myapp.pl fastcgi
+ $ ./myapp.pl fastcgi
...Blocking FastCGI main loop...
- % ./myapp.pl
+ $ ./myapp.pl
...List of available commands (or automatically detected environment)...
=head2 Start
@@ -157,7 +157,7 @@ Your application will automatically reload itself if you start it with the
C<morbo> development web server, so you don't have to restart the server
after every change.
- % morbo myapp.pl
+ $ morbo myapp.pl
Server available at http://127.0.0.1:3000.
=head2 Routes
@@ -548,12 +548,6 @@ constructs.
shift->render(text => 'Hello Mojolicious!');
};
-However you might want to disable automatic route caching in case there are
-routes responding to the same path without conditions attached, since those
-would otherwise get precedence once cached.
-
- app->routes->cache(0);
-
=head2 Sessions
Signed cookie based sessions just work out of the box as soon as you start
@@ -715,8 +709,8 @@ Static files will be automatically served from the C<DATA> section
@@ test.txt (base64)
dGVzdCAxMjMKbGFsYWxh
- % mkdir public
- % mv something.js public/something.js
+ $ mkdir public
+ $ mv something.js public/something.js
=head2 Testing
@@ -734,7 +728,7 @@ it with normal Perl unit tests.
Run all unit tests with the C<test> command.
- % ./myapp.pl test
+ $ ./myapp.pl test
To make your tests more noisy and show you all log messages you can also
change the application log level directly in your test files.
@@ -746,14 +740,14 @@ change the application log level directly in your test files.
To disable debug messages later in a production setup you can change the
L<Mojolicious> mode, default will be C<development>.
- % ./myapp.pl --mode production
+ $ ./myapp.pl --mode production
=head2 Logging
L<Mojo::Log> messages will be automatically written to a C<log/$mode.log>
file if a C<log> directory exists.
- % mkdir log
+ $ mkdir log
For more control the L<Mojolicious> instance can be accessed directly.
@@ -790,7 +784,7 @@ L<Mojolicious::Lite> and L<Mojolicious> applications.
Both share about 99% of the same code, so almost everything you learned in
this tutorial applies there too. :)
- % mojo generate app
+ $ mojo generate app
=head2 More
@@ -157,8 +157,8 @@ File extension of config file, defaults to C<conf>.
plugin config => {file => 'myapp.conf'};
plugin config => {file => '/etc/foo.stuff'};
-Configuration file, defaults to the value of C<MOJO_CONFIG> or C<myapp.conf>
-in the application home directory.
+Configuration file, defaults to the value of the C<MOJO_CONFIG> environment
+variable or C<myapp.conf> in the application home directory.
=head2 C<stash_key>
@@ -42,7 +42,7 @@ sub register {
$app->helper(
dumper => sub {
shift;
- Data::Dumper->new([@_])->Maxdepth(2)->Indent(1)->Terse(1)->Dump;
+ Data::Dumper->new([@_])->Indent(1)->Terse(1)->Dump;
}
);
@@ -15,7 +15,6 @@ sub register {
$path = $3;
$path = '/' unless defined $path;
$host = qr/^$host$/i;
- $app->routes->cache(0);
}
else { $path = $prefix }
@@ -47,7 +46,7 @@ Mojolicious::Plugin::Mount - Application Mount Plugin
my $example = plugin mount => {'/example' => '/home/sri/example.pl'};
$example->to(message => 'It works great!');
- # Mount application with host (automatically disables route caching)
+ # Mount application with host
plugin mount => {'mojolicio.us' => '/home/sri/myapp.pl'};
# Host and path
@@ -69,8 +69,7 @@ sub register {
my $path = Pod::Simple::Search->new->find($module, @PATHS);
# Redirect to CPAN
- my $cpan = 'http://search.cpan.org/perldoc';
- return $self->redirect_to("$cpan?$module")
+ return $self->redirect_to("http://metacpan.org/module/$module")
unless $path && -r $path;
# Turn POD into HTML
@@ -83,10 +82,9 @@ sub register {
$dom->find('a[href]')->each(
sub {
my $attrs = shift->attrs;
- if ($attrs->{href} =~ /^$cpan/) {
- $attrs->{href} =~ s/^$cpan\?/$perldoc/;
- $attrs->{href} =~ s/%3A%3A/\//gi;
- }
+ $attrs->{href} =~ s/%3A%3A/\//gi
+ if $attrs->{href}
+ =~ s/^http\:\/\/search\.cpan\.org\/perldoc\?/$perldoc/;
}
);
@@ -493,8 +493,8 @@ Generate script tag for C<Javascript> asset.
<%= link_to 'http://mojolicio.us' => begin %>Mojolicious<% end %>
<%= link_to url_for->query(foo => $foo) => begin %>Retry<% end %>
-Generate link to route, path or URL, by default the capitalized link target
-will be used as content.
+Generate link to route, path or URL, defaults to using the capitalized link
+target as content.
<a href="/path/to/index">Home</a>
<a href="/path/to/index">Home</a>
@@ -284,7 +284,7 @@ L<Mojolicious::Renderer> implements the following attributes.
my $cache = $renderer->cache;
$renderer = $renderer->cache(Mojo::Cache->new);
-Renderer cache, by default a L<Mojo::Cache> object.
+Renderer cache, defaults to a L<Mojo::Cache> object.
Note that this attribute is EXPERIMENTAL and might change without warning!
=head2 C<default_format>
@@ -204,7 +204,7 @@ sub _compile {
sub _compile_req {
my $req = shift;
return "($req)" if !ref $req || ref $req ne 'ARRAY';
- return '(' . join('|', @$req) . ')';
+ return '(' . join('|', reverse sort @$req) . ')';
}
sub _tokenize {
@@ -212,6 +212,9 @@ sub over {
return $self unless @_;
my $conditions = ref $_[0] eq 'ARRAY' ? $_[0] : [@_];
push @{$self->conditions}, @$conditions;
+ my $root = my $parent = $self;
+ while ($parent = $parent->parent) { $root = $parent }
+ $root->cache(0);
return $self;
}
@@ -674,13 +677,9 @@ The children of this routes object, used for nesting routes.
my $cache = $r->cache;
$r = $r->cache(Mojo::Cache->new);
-Routing cache, by default a L<Mojo::Cache> object.
+Routing cache, defaults to a L<Mojo::Cache> object.
Note that this attribute is EXPERIMENTAL and might change without warning!
- $r->cache(0);
-
-Route caching can also be disabled with a false value.
-
=head2 C<conditions>
my $conditions = $r->conditions;
@@ -743,8 +742,7 @@ Route has no specific end, remaining characters will be captured in C<path>.
my $pattern = $r->pattern;
$r = $r->pattern(Mojolicious::Routes::Pattern->new);
-Pattern for this route, by default a L<Mojolicious::Routes::Pattern> object
-and used for matching.
+Pattern for this route, defaults to a L<Mojolicious::Routes::Pattern> object.
=head2 C<shortcuts>
@@ -894,7 +892,7 @@ Note that the name C<current> is reserved for refering to the current route.
$r = $r->over(foo => qr/\w+/);
-Apply condition parameters to this route.
+Apply condition parameters to this route and disable routing cache.
=head2 C<parse>
@@ -63,7 +63,7 @@
%= link_to Documentation => 'http://mojolicio.us/perldoc'
%= link_to Wiki => 'https://github.com/kraih/mojo/wiki'
%= link_to GitHub => 'https://github.com/kraih/mojo'
- %= link_to CPAN => 'http://search.cpan.org/dist/Mojolicious'
+ %= link_to CPAN => 'http://metacpan.org/release/Mojolicious/'
%= link_to MailingList => 'http://groups.google.com/group/mojolicious'
%= link_to Blog => 'http://blog.kraih.com'
%= link_to Twitter => 'http://twitter.com/kraih'
@@ -11,6 +11,7 @@
background-color: #f5f6f8;
color: #333;
font: 0.9em Verdana, sans-serif;
+ line-height: 1.5;
margin: 0;
text-shadow: #ddd 0 1px 0;
}
@@ -51,6 +52,10 @@
padding-top: 7em;
}
#perldoc > ul:first-of-type a { text-decoration: none; }
+ #wrapperlicious {
+ max-width: 1000px;
+ margin: 0 auto;
+ }
% end
</head>
<body onload="prettyPrint()">
@@ -58,25 +63,27 @@
% my $link = begin
%= link_to shift, shift, class => "mojoscroll"
% end
- <div id="perldoc">
- <h1><a id="toc">TABLE OF CONTENTS</a></h1>
- <ul>
- % for my $section (@$sections) {
- <li>
- %= $link->(splice @$section, 0, 2)
- % if (@$section) {
- <ul>
- % while (@$section) {
- <li>
- %= $link->(splice @$section, 0, 2)
- </li>
- % }
- </ul>
- % }
- </li>
- % }
- </ul>
- %= content_for 'perldoc'
+ <div id="wrapperlicious">
+ <div id="perldoc">
+ <h1><a id="toc">TABLE OF CONTENTS</a></h1>
+ <ul>
+ % for my $section (@$sections) {
+ <li>
+ %= $link->(splice @$section, 0, 2)
+ % if (@$section) {
+ <ul>
+ % while (@$section) {
+ <li>
+ %= $link->(splice @$section, 0, 2)
+ </li>
+ % }
+ </ul>
+ % }
+ </li>
+ % }
+ </ul>
+ %= content_for 'perldoc'
+ </div>
</div>
<div id="footer">
%= link_to 'http://mojolicio.us' => begin
@@ -33,7 +33,7 @@ has static => sub { Mojolicious::Static->new };
has types => sub { Mojolicious::Types->new };
our $CODENAME = 'Smiling Face With Sunglasses';
-our $VERSION = '1.64';
+our $VERSION = '1.68';
# "These old doomsday devices are dangerously unstable.
# I'll rest easier not knowing where they are."
@@ -304,8 +304,8 @@ TLS, Bonjour, IDNA, Comet (long polling), chunking and multipart support.
=item *
-Built-in async IO web server supporting epoll, kqueue, UNIX domain sockets
-and hot deployment, perfect for embedding.
+Built-in async I/O web server supporting libev and hot deployment, perfect
+for embedding.
=item *
@@ -325,7 +325,7 @@ Fresh code based upon years of experience developing L<Catalyst>.
All you need is a oneliner, it takes less than a minute.
- sudo sh -c "curl -L cpanmin.us | perl - Mojolicious"
+ $ sudo sh -c "curl -L cpanmin.us | perl - Mojolicious"
=head2 Getting Started
@@ -338,12 +338,12 @@ These three lines are a whole web application.
app->start;
To run this example with the built-in development web server just put the
-code into a file and execute it with C<perl>.
+code into a file and start it with C<morbo>.
- % perl hello.pl daemon
+ $ morbo hello.pl
Server available at http://127.0.0.1:3000.
- % curl http://127.0.0.1:3000/
+ $ curl http://127.0.0.1:3000/
Hello World!
=head2 Duct Tape For The HTML5 Web
@@ -388,9 +388,10 @@ Web development for humans, making hard things possible and everything fun.
__DATA__
@@ clock.html.ep
- % my ($second, $minute, $hour) = (localtime(time))[0, 1, 2];
+ % use Time::Piece;
+ % my $now = localtime;
<%= link_to clock => begin %>
- The time is <%= $hour %>:<%= $minute %>:<%= $second %>.
+ The time is <%= $now->hms %>.
<% end %>
=head2 Growing
@@ -466,7 +467,7 @@ especially when working in a team.
# All common HTTP verbs are supported
$example->post('/title')->to('#title');
- # ... and much, much more
+ # ...and much, much more
# (including multiple, auto-discovered controllers)
$r->websocket('/echo')->to('realtime#echo');
}
@@ -476,9 +477,10 @@ especially when working in a team.
Through all of these changes, your action code and templates can stay almost
exactly the same.
- % my ($second, $minute, $hour) = (localtime(time))[0, 1, 2];
+ % use Time::Piece;
+ % my $now = localtime;
<%= link_to clock => begin %>
- The time is <%= $hour %>:<%= $minute %>:<%= $second %>.
+ The time is <%= $now->hms %>.
<% end %>
Mojolicious has been designed from the ground up for a fun and unique
@@ -526,23 +528,26 @@ L<Mojolicious::Controller>.
my $mode = $app->mode;
$app = $app->mode('production');
-The operating mode for your application.
-It defaults to the value of the environment variable C<MOJO_MODE> or
-C<development>.
-Mojo will name the log file after the current mode and modes other than
-C<development> will result in limited log output.
-
-If you want to add per mode logic to your application, you can add a sub
-to your application named C<$mode_mode>.
+The operating mode for your application, defaults to the value of the
+C<MOJO_MODE> environment variable or C<development>.
+You can also add per mode logic to your application by defining methods named
+C<$mode_mode> in the application class, which will be called right before
+C<startup>.
sub development_mode {
my $self = shift;
+ ...
}
sub production_mode {
my $self = shift;
+ ...
}
+Right before calling C<startup> and mode specific methods, L<Mojolicious>
+will pick up the current mode, name the log file after it and raise the log
+level from C<debug> to C<info> if it has a value other than C<development>.
+
=head2 C<on_process>
my $process = $app->on_process;
@@ -562,7 +567,7 @@ the sledgehammer in your toolbox.
my $plugins = $app->plugins;
$app = $app->plugins(Mojolicious::Plugins->new);
-The plugin loader, by default a L<Mojolicious::Plugins> object.
+The plugin loader, defaults to a L<Mojolicious::Plugins> object.
You can usually leave this alone, see L<Mojolicious::Plugin> if you want to
write a plugin.
@@ -571,7 +576,7 @@ write a plugin.
my $renderer = $app->renderer;
$app = $app->renderer(Mojolicious::Renderer->new);
-Used in your application to render content, by default a
+Used in your application to render content, defaults to a
L<Mojolicious::Renderer> object.
The two main renderer plugins L<Mojolicious::Plugin::EpRenderer> and
L<Mojolicious::Plugin::EplRenderer> contain more specific information.
@@ -581,7 +586,7 @@ L<Mojolicious::Plugin::EplRenderer> contain more specific information.
my $routes = $app->routes;
$app = $app->routes(Mojolicious::Routes->new);
-The routes dispatcher, by default a L<Mojolicious::Routes> object.
+The routes dispatcher, defaults to a L<Mojolicious::Routes> object.
You use this in your startup method to define the url endpoints for your
application.
@@ -607,7 +612,7 @@ the log file reminding you to change your passphrase.
my $sessions = $app->sessions;
$app = $app->sessions(Mojolicious::Sessions->new);
-Simple signed cookie based sessions, by default a L<Mojolicious::Sessions>
+Simple signed cookie based sessions, defaults to a L<Mojolicious::Sessions>
object.
=head2 C<static>
@@ -615,7 +620,7 @@ object.
my $static = $app->static;
$app = $app->static(Mojolicious::Static->new);
-For serving static assets from your C<public> directory, by default a
+For serving static assets from your C<public> directory, defaults to a
L<Mojolicious::Static> object.
=head2 C<types>
@@ -624,7 +629,7 @@ L<Mojolicious::Static> object.
$app = $app->types(Mojolicious::Types->new);
Responsible for tracking the types of content you want to serve in your
-application, by default a L<Mojolicious::Types> object.
+application, defaults to a L<Mojolicious::Types> object.
You can easily register new types.
$app->types->type(twitter => 'text/tweet');
@@ -1049,6 +1054,8 @@ Lars Balker Rasmussen
Leon Brocard
+Magnus Holm
+
Maik Fischer
Marcus Ramberg
@@ -60,8 +60,8 @@ hypnotoad - Hypnotoad HTTP 1.1 And WebSocket Server
=head1 SYNOPSIS
- % hypnotoad --help
- % hypnotoad myapp.pl
+ $ hypnotoad --help
+ $ hypnotoad myapp.pl
=head1 DESCRIPTION
@@ -28,7 +28,7 @@ mojo - The Mojolicious Command System
=head1 SYNOPSIS
- % mojo --help
+ $ mojo --help
=head1 DESCRIPTION
@@ -64,8 +64,8 @@ morbo - Morbo HTTP 1.1 And WebSocket Development Server
=head1 SYNOPSIS
- % morbo --help
- % morbo myapp.pl
+ $ morbo --help
+ $ morbo myapp.pl
=head1 DESCRIPTION
@@ -3,8 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More;
@@ -3,8 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
# mod_fastcgi doesn't like small chunks
BEGIN { $ENV{MOJO_CHUNK_SIZE} = 131072 }
@@ -3,8 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More tests => 43;
@@ -5,7 +5,7 @@ use warnings;
use utf8;
-use Test::More tests => 597;
+use Test::More tests => 603;
# "Homer gave me a kidney: it wasn't his, I didn't need it,
# and it came postage due- but I appreciated the gesture!"
@@ -1808,3 +1808,14 @@ is $dom->a->b->c, qq/<c id="three">bar<\/c>\n<c id="four">baz<\/c>/,
'right result';
is_deeply [keys %$dom], [], 'root has no attributes';
is $dom->find('#nothing'), '', 'no result';
+
+# Append and prepend content
+$dom = Mojo::DOM->new('<a><b>Test<c /></b></a>');
+$dom->at('b')->append_content('<d />');
+is $dom->children->[0]->type, 'a', 'right element';
+is $dom->all_text, 'Test', 'right text';
+is $dom->at('c')->parent->type, 'b', 'right element';
+is $dom->at('d')->parent->type, 'b', 'right element';
+$dom->at('b')->prepend_content('<e>Mojo</e>');
+is $dom->at('e')->parent->type, 'b', 'right element';
+is $dom->all_text, 'Mojo Test', 'right text';
@@ -0,0 +1,113 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 36;
+
+# "Hi, Super Nintendo Chalmers!"
+use_ok 'Mojo::IOLoop::EventEmitter';
+
+# Normal event
+my $e = Mojo::IOLoop::EventEmitter->new;
+my $called = 0;
+$e->on(test1 => sub { $called++ });
+$e->emit('test1');
+is $called, 1, 'event was emitted once';
+
+# Error fallback
+my ($echo, $error);
+$e->on(error => sub { $error = pop });
+$e->on(test2 => sub { $echo .= 'echo: ' . pop });
+$e->on(
+ test2 => sub {
+ my ($self, $message) = @_;
+ die "test2: $message\n";
+ }
+);
+my $cb = sub { $echo .= 'echo2: ' . pop };
+$e->on(test2 => $cb);
+$e->emit('test2', 'works!');
+is $echo, 'echo: works!echo2: works!', 'right echo';
+is $error, qq/Event "test2" failed: test2: works!\n/, 'right error';
+$echo = $error = undef;
+is scalar @{$e->subscribers('test2')}, 3, 'three subscribers';
+$e->unsubscribe(test2 => $cb);
+is scalar @{$e->subscribers('test2')}, 2, 'two subscribers';
+$e->emit('test2', 'works!');
+is $echo, 'echo: works!', 'right echo';
+is $error, qq/Event "test2" failed: test2: works!\n/, 'right error';
+
+# Normal event again
+$e->emit('test1');
+is $called, 2, 'event was emitted twice';
+is scalar @{$e->subscribers('test1')}, 1, 'one subscriber';
+$e->emit('test1');
+$e->unsubscribe(test1 => $e->subscribers('test1')->[0]);
+is $called, 3, 'event was emitted three times';
+is scalar @{$e->subscribers('test1')}, 0, 'no subscribers';
+$e->emit('test1');
+is $called, 3, 'event was not emitted again';
+$e->emit('test1');
+is $called, 3, 'event was not emitted again';
+
+# One time event
+my $once = 0;
+$e->once(one_time => sub { $once++ });
+is scalar @{$e->subscribers('one_time')}, 1, 'one subscriber';
+$e->emit('one_time');
+is $once, 1, 'event was emitted once';
+is scalar @{$e->subscribers('one_time')}, 0, 'no subscribers';
+$e->emit('one_time');
+is $once, 1, 'event was not emitted again';
+$e->emit('one_time');
+is $once, 1, 'event was not emitted again';
+$e->emit('one_time');
+is $once, 1, 'event was not emitted again';
+
+# Nested one time events
+$once = 0;
+$e->once(
+ one_time => sub {
+ $e->once(
+ one_time => sub {
+ $e->once(one_time => sub { $once++ });
+ }
+ );
+ }
+);
+is scalar @{$e->subscribers('one_time')}, 1, 'one subscriber';
+$e->emit('one_time');
+is $once, 0, 'only first event was emitted';
+is scalar @{$e->subscribers('one_time')}, 1, 'one subscriber';
+$e->emit('one_time');
+is $once, 0, 'only second event was emitted';
+is scalar @{$e->subscribers('one_time')}, 1, 'one subscriber';
+$e->emit('one_time');
+is $once, 1, 'third event was emitted';
+is scalar @{$e->subscribers('one_time')}, 0, 'no subscribers';
+$e->emit('one_time');
+is $once, 1, 'event was not emitted again';
+$e->emit('one_time');
+is $once, 1, 'event was not emitted again';
+$e->emit('one_time');
+is $once, 1, 'event was not emitted again';
+
+# Unsubscribe
+$e = Mojo::IOLoop::EventEmitter->new;
+my $counter = 0;
+$cb = $e->on(foo => sub { $counter++ });
+$e->on(foo => sub { $counter++ });
+$e->on(foo => sub { $counter++ });
+$e->unsubscribe(foo => $e->once(foo => sub { $counter++ }));
+is scalar @{$e->subscribers('foo')}, 3, 'three subscribers';
+$e->emit('foo');
+is $counter, 3, 'event was emitted three times';
+$e->unsubscribe(foo => $cb);
+is scalar @{$e->subscribers('foo')}, 2, 'two subscribers';
+$e->emit('foo');
+is $counter, 5, 'event was emitted two times';
+$e->unsubscribe(foo => $_) for @{$e->subscribers('foo')};
+is scalar @{$e->subscribers('foo')}, 0, 'no subscribers';
+$e->emit('foo');
+is $counter, 5, 'event was not emitted again';
@@ -4,7 +4,7 @@ use strict;
use warnings;
# "Remember, you can always find East by staring directly at the sun."
-use Test::More tests => 37;
+use Test::More tests => 41;
# "So, have a merry Christmas, a happy Hanukkah, a kwaazy Kwanza,
# a tip-top Tet, and a solemn, dignified, Ramadan.
@@ -34,6 +34,10 @@ is_deeply $hash->{Expect}, [['continue-100']], 'right structure';
is_deeply $hash->{'Content-Type'}, [['text/html']], 'right structure';
is_deeply [sort @{$headers->names}], [qw/Connection Content-Type Expect/],
'right structure';
+$headers->expires('Thu, 01 Dec 1994 16:00:00 GMT');
+$headers->cache_control('public');
+is $headers->expires, 'Thu, 01 Dec 1994 16:00:00 GMT', 'right value';
+is $headers->cache_control, 'public', 'right value';
# Multiline values
$headers = Mojo::Headers->new;
@@ -56,11 +60,15 @@ $headers = Mojo::Headers->new;
isa_ok $headers->parse(<<'EOF'), 'Mojo::Headers', 'right return value';
Content-Type: text/plain
Expect: 100-continue
+Cache-control: public
+Expires: Thu, 01 Dec 1994 16:00:00 GMT
EOF
-ok $headers->is_done, 'parser is done';
-is $headers->content_type, 'text/plain', 'right value';
-is $headers->expect, '100-continue', 'right value';
+ok $headers->is_done, 'parser is done';
+is $headers->content_type, 'text/plain', 'right value';
+is $headers->expect, '100-continue', 'right value';
+is $headers->cache_control, 'public', 'right value';
+is $headers->expires, 'Thu, 01 Dec 1994 16:00:00 GMT', 'right value';
# Set headers from hash
$headers = Mojo::Headers->new;
@@ -3,8 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More;
@@ -3,10 +3,13 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
-use Test::More tests => 12;
+use Test::More tests => 11;
# "Marge, you being a cop makes you the man!
# Which makes me the woman, and I have no interest in that,
@@ -14,8 +17,6 @@ use Test::More tests => 12;
# which as we discussed, is strictly a comfort thing."
use_ok 'Mojo::IOLoop';
-use IO::Handle;
-
# Custom watcher
package MyWatcher;
use Mojo::Base 'Mojo::IOWatcher';
@@ -28,16 +29,6 @@ my $loop = Mojo::IOLoop->new;
Mojo::IOLoop->iowatcher(MyWatcher->new);
is ref $loop->iowatcher, 'MyWatcher', 'right class';
-# Readonly handle
-my $ro = IO::Handle->new;
-$ro->fdopen(fileno(DATA), 'r');
-my $error;
-$loop->connect(
- handle => $ro,
- on_read => sub { },
- on_error => sub { $error = pop }
-);
-
# Ticks
my $ticks = 0;
my $id = $loop->recurring(0 => sub { $ticks++ });
@@ -84,16 +75,17 @@ $loop->recurring(0 => sub { $after++ });
$loop->drop($id);
$loop->timer(1 => sub { shift->stop });
$loop->start;
-ok $after > 2, 'more than two ticks';
+$loop->one_tick;
+ok $after > 1, 'more than one tick';
is $ticks, $before, 'no additional ticks';
-
# Recurring timer
my $count = 0;
$loop->recurring(0.5 => sub { $count++ });
$loop->timer(3 => sub { shift->stop });
$loop->start;
-ok $count > 4, 'more than four recurring events';
+$loop->one_tick;
+ok $count > 3, 'more than three recurring events';
# Handle
my $port = Mojo::IOLoop->generate_port;
@@ -117,9 +109,6 @@ $loop->connect(
$loop->start;
isa_ok $handle, 'IO::Socket', 'right reference';
-# Readonly handle
-is $error, undef, 'no error';
-
# Dropped listen socket
$port = Mojo::IOLoop->generate_port;
$id = $loop->listen(port => $port);
@@ -133,7 +122,7 @@ $loop->connect(
}
);
$loop->start;
-$error = undef;
+my $error;
my $connected;
$loop->connect(
address => 'localhost',
@@ -147,5 +136,3 @@ $loop->connect(
$loop->start;
ok $error, 'has error';
ok !$connected, 'not connected';
-
-__DATA__
@@ -3,8 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
# To regenerate all required certificates run these commands
# openssl genrsa -out ca.key 1024
@@ -27,15 +30,18 @@ BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
# openssl req -x509 -days 7300 -key badclient.key -in badclient.csr \
# -out badclient.crt
use Test::More;
-use Mojo::IOLoop;
+use Mojo::IOLoop::Server;
+use Mojo::IOLoop::Stream;
plan skip_all => 'set TEST_TLS to enable this test (developer only!)'
unless $ENV{TEST_TLS};
plan skip_all => 'IO::Socket::SSL 1.43 required for this test!'
- unless Mojo::IOLoop::TLS;
+ unless Mojo::IOLoop::Server::TLS;
plan skip_all => 'Windows is too fragile for this test!'
- if Mojo::IOLoop::WINDOWS;
+ if Mojo::IOLoop::Stream::WINDOWS;
plan tests => 16;
+use Mojo::IOLoop;
+
# "To the panic room!
# We don't have a panic room.
# To the panic room store!"
@@ -147,7 +153,7 @@ $id = $loop->connect(
$loop->connection_timeout($id => '0.5');
$loop->timer(1 => sub { shift->stop });
$loop->start;
-ok $error, 'has error';
+ok !$error, 'no error';
ok $cerror, 'has error';
# Valid client certificate accepted by callback
@@ -196,7 +202,7 @@ $id = $loop->connect(
);
$loop->connection_timeout($id => '0.5');
$loop->start;
-ok $error, 'has error';
+ok !$error, 'no error';
ok $cerror, 'has error';
# Invalid certificate authority
@@ -225,5 +231,5 @@ $id = $loop->connect(
$loop->connection_timeout($id => '0.5');
$loop->timer(1 => sub { shift->stop });
$loop->start;
-ok $error, 'has error';
+ok !$error, 'no error';
ok $cerror, 'has error';
@@ -3,12 +3,15 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
# "I don't mind being called a liar when I'm lying, or about to lie,
# or just finished lying, but NOT WHEN I'M TELLING THE TRUTH."
-use Test::More tests => 35;
+use Test::More tests => 50;
use_ok 'Mojo::IOWatcher';
@@ -24,6 +27,7 @@ my $listen = IO::Socket::INET->new(
Proto => 'tcp'
);
my $watcher = Mojo::IOWatcher->new;
+isa_ok $watcher, 'Mojo::IOWatcher', 'right object';
my ($readable, $writable);
$watcher->add(
$listen,
@@ -43,7 +47,9 @@ is $writable, undef, 'handle is not writable';
# Accept
my $server = $listen->accept;
-$watcher = $watcher->new;
+$watcher = undef;
+$watcher = Mojo::IOWatcher->new;
+isa_ok $watcher, 'Mojo::IOWatcher', 'right object';
$readable = $writable = undef;
$watcher->add(
$client,
@@ -55,7 +61,9 @@ is $readable, undef, 'handle is not readable';
is $writable, 1, 'handle is writable';
print $client "hello!\n";
sleep 1;
-$watcher = $watcher->new;
+$watcher = undef;
+$watcher = Mojo::IOWatcher->new;
+isa_ok $watcher, 'Mojo::IOWatcher', 'right object';
$readable = $writable = undef;
$watcher->add(
$server,
@@ -80,7 +88,7 @@ $watcher->add(
on_readable => sub { $readable++ },
on_writable => sub { $writable++ }
);
-$watcher->watch(0);
+$watcher->one_tick(0);
is $readable, 1, 'handle is readable';
is $writable, 1, 'handle is writable';
@@ -99,19 +107,47 @@ is $readable, 3, 'handle is readable again';
is $writable, 3, 'handle is writable again';
is $timer, 1, 'timer was not triggered';
is $recurring, 2, 'recurring was triggered again';
-$watcher->watch(0);
+$watcher->one_tick(0);
is $readable, 4, 'handle is readable again';
is $writable, 4, 'handle is writable again';
is $timer, 1, 'timer was not triggered';
-is $recurring, 2, 'recurring was not triggered';
+is $recurring, 3, 'recurring was not triggered';
$watcher->one_tick(0);
is $readable, 5, 'handle is readable again';
is $writable, 5, 'handle is writable again';
is $timer, 1, 'timer was not triggered';
-is $recurring, 3, 'recurring was triggered again';
+is $recurring, 4, 'recurring was triggered again';
$watcher->cancel($id);
$watcher->one_tick(0);
is $readable, 6, 'handle is readable again';
is $writable, 6, 'handle is writable again';
is $timer, 1, 'timer was not triggered';
-is $recurring, 3, 'recurring was not triggered again';
+is $recurring, 4, 'recurring was not triggered again';
+
+# Reset
+$watcher = undef;
+$watcher = Mojo::IOWatcher->new;
+isa_ok $watcher, 'Mojo::IOWatcher', 'right object';
+$watcher->one_tick(0);
+is $readable, 6, 'io event was not triggered again';
+is $writable, 6, 'io event was not triggered again';
+my $watcher2 = Mojo::IOWatcher->new;
+isa_ok $watcher2, 'Mojo::IOWatcher', 'right object';
+
+# Parallel loops
+$timer = 0;
+$watcher->recurring(0 => sub { $timer++ });
+my $timer2 = 0;
+$watcher2->recurring(0 => sub { $timer2++ });
+$watcher->one_tick(0);
+is $timer, 1, 'timer was triggered';
+is $timer2, 0, 'timer was not triggered';
+$watcher2->one_tick(0);
+is $timer, 1, 'timer was not triggered';
+is $timer2, 1, 'timer was triggered';
+$watcher->one_tick(0);
+is $timer, 2, 'timer was triggered';
+is $timer2, 1, 'timer was not triggered';
+$watcher2->one_tick(0);
+is $timer, 2, 'timer was not triggered';
+is $timer2, 2, 'timer was triggered';
@@ -1,123 +0,0 @@
-#!/usr/bin/env perl
-
-use strict;
-use warnings;
-
-# Disable Bonjour and IPv6
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1 }
-
-use Test::More;
-
-# "Have you ever seen that Blue Man Group? Total ripoff of the Smurfs.
-# And the Smurfs, well, they SUCK."
-plan skip_all => 'set TEST_EPOLL to enable this test (developer only!)'
- unless $ENV{TEST_EPOLL};
-plan skip_all => 'IO::Epoll 0.02 required for this test!'
- unless eval 'use IO::Epoll 0.02; 1';
-plan tests => 35;
-
-use_ok 'Mojo::IOWatcher::Epoll';
-
-use IO::Socket::INET;
-use Mojo::IOLoop;
-
-# Listen
-my $port = Mojo::IOLoop->generate_port;
-my $listen = IO::Socket::INET->new(
- Listen => 5,
- LocalAddr => '127.0.0.1',
- LocalPort => $port,
- Proto => 'tcp'
-);
-my $watcher = Mojo::IOWatcher::Epoll->new;
-my ($readable, $writable);
-$watcher->add(
- $listen,
- on_readable => sub { $readable++ },
- on_writable => sub { $writable++ }
-);
-$watcher->one_tick(0);
-is $readable, undef, 'handle is not readable';
-is $writable, undef, 'handle is not writable';
-
-# Connect
-my $client =
- IO::Socket::INET->new(PeerAddr => '127.0.0.1', PeerPort => $port);
-$watcher->one_tick(0);
-is $readable, 1, 'handle is readable';
-is $writable, undef, 'handle is not writable';
-
-# Accept
-my $server = $listen->accept;
-$watcher = $watcher->new;
-$readable = $writable = undef;
-$watcher->add(
- $client,
- on_readable => sub { $readable++ },
- on_writable => sub { $writable++ }
-);
-$watcher->one_tick(0);
-is $readable, undef, 'handle is not readable';
-is $writable, 1, 'handle is writable';
-print $client "hello!\n";
-sleep 1;
-$watcher = $watcher->new;
-$readable = $writable = undef;
-$watcher->add(
- $server,
- on_readable => sub { $readable++ },
- on_writable => sub { $writable++ }
-);
-$watcher->not_writing($server);
-$watcher->one_tick(0);
-is $readable, 1, 'handle is readable';
-is $writable, undef, 'handle is not writable';
-$watcher->writing($server);
-$watcher->one_tick(0);
-is $readable, 2, 'handle is readable';
-is $writable, 1, 'handle is writable';
-$watcher->not_writing($server);
-$watcher->one_tick(0);
-is $readable, 3, 'handle is readable';
-is $writable, 1, 'handle is not writable';
-$readable = $writable = undef;
-$watcher->add(
- $server,
- on_readable => sub { $readable++ },
- on_writable => sub { $writable++ }
-);
-$watcher->watch(0);
-is $readable, 1, 'handle is readable';
-is $writable, 1, 'handle is writable';
-
-# Timers
-my ($timer, $recurring);
-$watcher->timer(0 => sub { $timer++ });
-$watcher->cancel($watcher->timer(0 => sub { $timer++ }));
-my $id = $watcher->recurring(0 => sub { $recurring++ });
-$watcher->one_tick(0);
-is $readable, 2, 'handle is readable again';
-is $writable, 2, 'handle is writable again';
-is $timer, 1, 'timer was triggered';
-is $recurring, 1, 'recurring was triggered';
-$watcher->one_tick(0);
-is $readable, 3, 'handle is readable again';
-is $writable, 3, 'handle is writable again';
-is $timer, 1, 'timer was not triggered';
-is $recurring, 2, 'recurring was triggered again';
-$watcher->watch(0);
-is $readable, 4, 'handle is readable again';
-is $writable, 4, 'handle is writable again';
-is $timer, 1, 'timer was not triggered';
-is $recurring, 2, 'recurring was not triggered';
-$watcher->one_tick(0);
-is $readable, 5, 'handle is readable again';
-is $writable, 5, 'handle is writable again';
-is $timer, 1, 'timer was not triggered';
-is $recurring, 3, 'recurring was triggered again';
-$watcher->cancel($id);
-$watcher->one_tick(0);
-is $readable, 6, 'handle is readable again';
-is $writable, 6, 'handle is writable again';
-is $timer, 1, 'timer was not triggered';
-is $recurring, 3, 'recurring was not triggered again';
@@ -0,0 +1,154 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+# Disable Bonjour and IPv6
+BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1 }
+
+use Test::More;
+
+# "Oh well. At least we'll die doing what we love: inhaling molten rock."
+plan skip_all => 'set TEST_EV to enable this test (developer only!)'
+ unless $ENV{TEST_EV};
+plan skip_all => 'EV required for this test!' unless eval 'use EV; 1';
+plan tests => 50;
+
+use_ok 'Mojo::IOWatcher::EV';
+
+use IO::Socket::INET;
+use Mojo::IOLoop;
+
+# Listen
+my $port = Mojo::IOLoop->generate_port;
+my $listen = IO::Socket::INET->new(
+ Listen => 5,
+ LocalAddr => '127.0.0.1',
+ LocalPort => $port,
+ Proto => 'tcp'
+);
+my $watcher = Mojo::IOWatcher::EV->new;
+isa_ok $watcher, 'Mojo::IOWatcher::EV', 'right object';
+my ($readable, $writable);
+$watcher->add(
+ $listen,
+ on_readable => sub { $readable++ },
+ on_writable => sub { $writable++ }
+);
+$watcher->one_tick(0);
+is $readable, undef, 'handle is not readable';
+is $writable, undef, 'handle is not writable';
+
+# Connect
+my $client =
+ IO::Socket::INET->new(PeerAddr => '127.0.0.1', PeerPort => $port);
+$watcher->one_tick(0);
+is $readable, 1, 'handle is readable';
+is $writable, undef, 'handle is not writable';
+
+# Accept
+my $server = $listen->accept;
+$watcher = undef;
+$watcher = Mojo::IOWatcher::EV->new;
+isa_ok $watcher, 'Mojo::IOWatcher::EV', 'right object';
+$readable = $writable = undef;
+$watcher->add(
+ $client,
+ on_readable => sub { $readable++ },
+ on_writable => sub { $writable++ }
+);
+$watcher->one_tick(0);
+is $readable, undef, 'handle is not readable';
+is $writable, 1, 'handle is writable';
+print $client "hello!\n";
+sleep 1;
+$watcher = undef;
+$watcher = Mojo::IOWatcher::EV->new;
+isa_ok $watcher, 'Mojo::IOWatcher::EV', 'right object';
+$readable = $writable = undef;
+$watcher->add(
+ $server,
+ on_readable => sub { $readable++ },
+ on_writable => sub { $writable++ }
+);
+$watcher->not_writing($server);
+$watcher->one_tick(0);
+is $readable, 1, 'handle is readable';
+is $writable, undef, 'handle is not writable';
+$watcher->writing($server);
+$watcher->one_tick(0);
+is $readable, 2, 'handle is readable';
+is $writable, 1, 'handle is writable';
+$watcher->not_writing($server);
+$watcher->one_tick(0);
+is $readable, 3, 'handle is readable';
+is $writable, 1, 'handle is not writable';
+$readable = $writable = undef;
+$watcher->add(
+ $server,
+ on_readable => sub { $readable++ },
+ on_writable => sub { $writable++ }
+);
+$watcher->one_tick(0);
+is $readable, 1, 'handle is readable';
+is $writable, 1, 'handle is writable';
+
+# Timers
+my ($timer, $recurring);
+$watcher->timer(0 => sub { $timer++ });
+$watcher->cancel($watcher->timer(0 => sub { $timer++ }));
+my $id = $watcher->recurring(0 => sub { $recurring++ });
+$watcher->one_tick(0);
+is $readable, 2, 'handle is readable again';
+is $writable, 2, 'handle is writable again';
+is $timer, 1, 'timer was triggered';
+is $recurring, 1, 'recurring was triggered';
+$watcher->one_tick(0);
+is $readable, 3, 'handle is readable again';
+is $writable, 3, 'handle is writable again';
+is $timer, 1, 'timer was not triggered';
+is $recurring, 2, 'recurring was triggered again';
+$watcher->one_tick(0);
+is $readable, 4, 'handle is readable again';
+is $writable, 4, 'handle is writable again';
+is $timer, 1, 'timer was not triggered';
+is $recurring, 3, 'recurring was not triggered';
+$watcher->one_tick(0);
+is $readable, 5, 'handle is readable again';
+is $writable, 5, 'handle is writable again';
+is $timer, 1, 'timer was not triggered';
+is $recurring, 4, 'recurring was triggered again';
+$watcher->cancel($id);
+$watcher->one_tick(0);
+is $readable, 6, 'handle is readable again';
+is $writable, 6, 'handle is writable again';
+is $timer, 1, 'timer was not triggered';
+is $recurring, 4, 'recurring was not triggered again';
+
+# Reset
+$watcher = undef;
+$watcher = Mojo::IOWatcher::EV->new;
+isa_ok $watcher, 'Mojo::IOWatcher::EV', 'right object';
+$watcher->one_tick(0);
+is $readable, 6, 'io event was not triggered again';
+is $writable, 6, 'io event was not triggered again';
+my $watcher2 = Mojo::IOWatcher::EV->new;
+isa_ok $watcher2, 'Mojo::IOWatcher', 'right object';
+
+# Parallel loops
+$timer = 0;
+$watcher->recurring(0 => sub { $timer++ });
+my $timer2 = 0;
+$watcher2->recurring(0 => sub { $timer2++ });
+$watcher->one_tick(0);
+is $timer, 1, 'timer was triggered';
+is $timer2, 0, 'timer was not triggered';
+$watcher2->one_tick(0);
+is $timer, 1, 'timer was not triggered';
+is $timer2, 1, 'timer was triggered';
+$watcher->one_tick(0);
+is $timer, 2, 'timer was triggered';
+is $timer2, 1, 'timer was not triggered';
+$watcher2->one_tick(0);
+is $timer, 2, 'timer was not triggered';
+is $timer2, 2, 'timer was triggered';
@@ -1,122 +0,0 @@
-#!/usr/bin/env perl
-
-use strict;
-use warnings;
-
-# Disable Bonjour and IPv6
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1 }
-
-use Test::More;
-
-# "Oh well. At least we'll die doing what we love: inhaling molten rock."
-plan skip_all => 'set TEST_KQUEUE to enable this test (developer only!)'
- unless $ENV{TEST_KQUEUE};
-plan skip_all => 'IO::KQueue 0.34 required for this test!'
- unless eval 'use IO::KQueue 0.34; 1';
-plan tests => 35;
-
-use_ok 'Mojo::IOWatcher::KQueue';
-
-use IO::Socket::INET;
-use Mojo::IOLoop;
-
-# Listen
-my $port = Mojo::IOLoop->generate_port;
-my $listen = IO::Socket::INET->new(
- Listen => 5,
- LocalAddr => '127.0.0.1',
- LocalPort => $port,
- Proto => 'tcp'
-);
-my $watcher = Mojo::IOWatcher::KQueue->new;
-my ($readable, $writable);
-$watcher->add(
- $listen,
- on_readable => sub { $readable++ },
- on_writable => sub { $writable++ }
-);
-$watcher->one_tick(0);
-is $readable, undef, 'handle is not readable';
-is $writable, undef, 'handle is not writable';
-
-# Connect
-my $client =
- IO::Socket::INET->new(PeerAddr => '127.0.0.1', PeerPort => $port);
-$watcher->one_tick(0);
-is $readable, 1, 'handle is readable';
-is $writable, undef, 'handle is not writable';
-
-# Accept
-my $server = $listen->accept;
-$watcher = $watcher->new;
-$readable = $writable = undef;
-$watcher->add(
- $client,
- on_readable => sub { $readable++ },
- on_writable => sub { $writable++ }
-);
-$watcher->one_tick(0);
-is $readable, undef, 'handle is not readable';
-is $writable, 1, 'handle is writable';
-print $client "hello!\n";
-sleep 1;
-$watcher = $watcher->new;
-$readable = $writable = undef;
-$watcher->add(
- $server,
- on_readable => sub { $readable++ },
- on_writable => sub { $writable++ }
-);
-$watcher->not_writing($server);
-$watcher->one_tick(0);
-is $readable, 1, 'handle is readable';
-is $writable, undef, 'handle is not writable';
-$watcher->writing($server);
-$watcher->one_tick(0);
-is $readable, 2, 'handle is readable';
-is $writable, 1, 'handle is writable';
-$watcher->not_writing($server);
-$watcher->one_tick(0);
-is $readable, 3, 'handle is readable';
-is $writable, 1, 'handle is not writable';
-$readable = $writable = undef;
-$watcher->add(
- $server,
- on_readable => sub { $readable++ },
- on_writable => sub { $writable++ }
-);
-$watcher->watch(0);
-is $readable, 1, 'handle is readable';
-is $writable, 1, 'handle is writable';
-
-# Timers
-my ($timer, $recurring);
-$watcher->timer(0 => sub { $timer++ });
-$watcher->cancel($watcher->timer(0 => sub { $timer++ }));
-my $id = $watcher->recurring(0 => sub { $recurring++ });
-$watcher->one_tick(0);
-is $readable, 2, 'handle is readable again';
-is $writable, 2, 'handle is writable again';
-is $timer, 1, 'timer was triggered';
-is $recurring, 1, 'recurring was triggered';
-$watcher->one_tick(0);
-is $readable, 3, 'handle is readable again';
-is $writable, 3, 'handle is writable again';
-is $timer, 1, 'timer was not triggered';
-is $recurring, 2, 'recurring was triggered again';
-$watcher->watch(0);
-is $readable, 4, 'handle is readable again';
-is $writable, 4, 'handle is writable again';
-is $timer, 1, 'timer was not triggered';
-is $recurring, 2, 'recurring was not triggered';
-$watcher->one_tick(0);
-is $readable, 5, 'handle is readable again';
-is $writable, 5, 'handle is writable again';
-is $timer, 1, 'timer was not triggered';
-is $recurring, 3, 'recurring was triggered again';
-$watcher->cancel($id);
-$watcher->one_tick(0);
-is $readable, 6, 'handle is readable again';
-is $writable, 6, 'handle is writable again';
-is $timer, 1, 'timer was not triggered';
-is $recurring, 3, 'recurring was not triggered again';
@@ -3,8 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More;
@@ -0,0 +1,47 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings;
+
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
+
+use Test::More tests => 16;
+
+# "Oh, I'm in no condition to drive. Wait a minute.
+# I don't have to listen to myself. I'm drunk."
+use_ok 'Mojo::IOLoop';
+
+my $r = Mojo::IOLoop->singleton->resolver;
+
+# Check IPv4 and IPv6 addresses
+is $r->is_ipv4('mojolicio.us'), undef, 'not an IPv4 address';
+is $r->is_ipv6('mojolicio.us'), undef, 'not an IPv6 address';
+is $r->is_ipv4('[::1]'), undef, 'not an IPv4 address';
+is $r->is_ipv6('[::1]'), 1, 'is an IPv6 address';
+is $r->is_ipv4('127.0.0.1'), 1, 'is an IPv4 address';
+is $r->is_ipv6('127.0.0.1'), undef, 'not an IPv6 address';
+is $r->is_ipv4('0::127.0.0.1'), undef, 'not an IPv4 address';
+is $r->is_ipv6('0::127.0.0.1'), 1, 'is an IPv6 address';
+is $r->is_ipv4('[0::127.0.0.1]'), undef, 'not an IPv4 address';
+is $r->is_ipv6('[0::127.0.0.1]'), 1, 'is an IPv6 address';
+is $r->is_ipv4('foo.1.1.1.1.de'), undef, 'not an IPv4 address';
+is $r->is_ipv6('foo.1.1.1.1.de'), undef, 'not an IPv4 address';
+is $r->is_ipv4('1.1.1.1.1.1'), undef, 'not an IPv4 address';
+is $r->is_ipv6('1.1.1.1.1.1'), undef, 'not an IPv4 address';
+
+# Lookup "localhost" (pass through)
+my $result;
+$r->lookup(
+ 'localhost',
+ sub {
+ my ($self, $address) = @_;
+ $result = $address;
+ Mojo::IOLoop->stop;
+ }
+);
+Mojo::IOLoop->start;
+is $result, '127.0.0.1', 'got an address';
@@ -3,19 +3,21 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More;
plan skip_all => 'set TEST_ONLINE to enable this test (developer only!)'
unless $ENV{TEST_ONLINE};
+plan skip_all => 'Perl 5.12 required for this test!' unless $] >= 5.012;
plan tests => 18;
use_ok 'Mojo::IOLoop';
use List::Util 'first';
-use Mojo::IOLoop;
-use Mojo::URL;
# "Your guilty consciences may make you vote Democratic, but secretly you all
# yearn for a Republican president to lower taxes, brutalize criminals, and
@@ -91,7 +93,7 @@ $r->resolve(
}
);
Mojo::IOLoop->start;
-like $result, $Mojo::URL::IPV6_RE, 'valid IPv6 record';
+is $r->is_ipv6($result), 1, 'valid IPv6 record';
ok $ttl, 'got a TTL value';
# Resolve CNAME record
@@ -149,7 +151,7 @@ $r->resolve(
}
);
Mojo::IOLoop->start;
-like $a1, $Mojo::URL::IPV4_RE, 'valid IPv4 record';
+is $r->is_ipv4($a1), 1, 'valid IPv4 record';
is $a1, $a2, 'PTR roundtrip succeeded';
# Resolve PTR record (IPv6)
@@ -167,13 +169,14 @@ Mojo::IOLoop->start;
ok $found, 'found IPv6 PTR record';
# Invalid DNS server
-ok scalar $r->servers, 'got a dns server';
+$r = Mojo::IOLoop::Resolver->new;
+ok scalar $r->servers, 'got a DNS server';
$r->servers('192.0.2.1', $r->servers);
-is $r->servers, '192.0.2.1', 'new invalid dns server';
+is $r->servers, '192.0.2.1', 'new invalid DNS server';
$r->lookup('google.com', sub { Mojo::IOLoop->stop });
Mojo::IOLoop->start;
my $fallback = $r->servers;
-isnt $fallback, '192.0.2.1', 'valid dns server';
+isnt $fallback, '192.0.2.1', 'valid DNS server';
$result = undef;
$r->lookup(
'google.com',
@@ -185,5 +188,5 @@ $r->lookup(
);
Mojo::IOLoop->start;
ok $result, 'got an address';
-is scalar $r->servers, $fallback, 'still the same dns server';
-isnt $fallback, '192.0.2.1', 'still valid dns server';
+is scalar $r->servers, $fallback, 'still the same DNS server';
+isnt $fallback, '192.0.2.1', 'still valid DNS server';
@@ -25,7 +25,7 @@ use warnings;
use utf8;
-use Test::More tests => 165;
+use Test::More tests => 188;
use File::Spec;
use File::Temp;
@@ -635,6 +635,43 @@ is $output->lines_after->[1]->[1], 'test', 'right line';
like "$output", qr/oops\! at template line 3, near "%= 1 \+ 1"./,
'right result';
+# Exception in template (empty perl lines)
+$mt = Mojo::Template->new;
+$output = $mt->render(<<'EOF');
+test
+123
+%
+% die 'oops!';
+%
+ %
+%
+%= 1 + 1
+test
+EOF
+isa_ok $output, 'Mojo::Exception', 'right exception';
+like $output->message, qr/oops\!/, 'right message';
+is $output->lines_before->[0]->[0], 1, 'right number';
+is $output->lines_before->[0]->[1], 'test', 'right line';
+ok $output->lines_before->[0]->[2], 'contains code';
+is $output->lines_before->[1]->[0], 2, 'right number';
+is $output->lines_before->[1]->[1], '123', 'right line';
+ok $output->lines_before->[1]->[2], 'contains code';
+is $output->lines_before->[2]->[0], 3, 'right number';
+is $output->lines_before->[2]->[1], '%', 'right line';
+is $output->lines_before->[2]->[2], '', 'right code';
+is $output->line->[0], 4, 'right number';
+is $output->line->[1], "% die 'oops!';", 'right line';
+is $output->lines_after->[0]->[0], 5, 'right number';
+is $output->lines_after->[0]->[1], '%', 'right line';
+is $output->lines_after->[0]->[2], '', 'right code';
+is $output->lines_after->[1]->[0], 6, 'right number';
+is $output->lines_after->[1]->[1], ' %', 'right line';
+is $output->lines_after->[1]->[2], '', 'right code';
+is $output->lines_after->[2]->[0], 7, 'right number';
+is $output->lines_after->[2]->[1], '%', 'right line';
+is $output->lines_after->[2]->[2], '', 'right code';
+like "$output", qr/oops\! at template line 4, near "%"./, 'right result';
+
# Exception in nested template
$mt = Mojo::Template->new;
$mt->tag_start('[$-');
@@ -5,7 +5,7 @@ use warnings;
use utf8;
-use Test::More tests => 322;
+use Test::More tests => 298;
# "I don't want you driving around in a car you built yourself.
# You can sit there complaining, or you can knit me some seat belts."
@@ -282,56 +282,6 @@ is $url->to_abs, 'http://kraih.com/foo///bar/23/', 'right absolute version';
is $url->is_abs, 1, 'is absolute';
is $url->to_rel, 'foo///bar/23/', 'right relative version';
-# Check host for IPv4 and IPv6 addresses
-$url = Mojo::URL->new('http://mojolicio.us');
-is $url->host, 'mojolicio.us', 'right host';
-is $url->is_ipv4, undef, 'not an IPv4 address';
-is $url->is_ipv6, undef, 'not an IPv6 address';
-$url = Mojo::URL->new('http://[::1]');
-is $url->host, '[::1]', 'right host';
-is $url->is_ipv4, undef, 'not an IPv4 address';
-is $url->is_ipv6, 1, 'is an IPv6 address';
-$url = Mojo::URL->new('http://127.0.0.1');
-is $url->host, '127.0.0.1', 'right host';
-is $url->is_ipv4, 1, 'is an IPv4 address';
-is $url->is_ipv6, undef, 'not an IPv6 address';
-$url = Mojo::URL->new('http://0::127.0.0.1');
-is $url->host, '0::127.0.0.1', 'right host';
-is $url->is_ipv4, undef, 'not an IPv4 address';
-is $url->is_ipv6, 1, 'is an IPv6 address';
-$url = Mojo::URL->new('http://[0::127.0.0.1]');
-is $url->host, '[0::127.0.0.1]', 'right host';
-is $url->is_ipv4, undef, 'not an IPv4 address';
-is $url->is_ipv6, 1, 'is an IPv6 address';
-$url = Mojo::URL->new('http://mojolicio.us:3000');
-is $url->host, 'mojolicio.us', 'right host';
-is $url->is_ipv4, undef, 'not an IPv4 address';
-is $url->is_ipv6, undef, 'not an IPv6 address';
-$url = Mojo::URL->new('http://[::1]:3000');
-is $url->host, '[::1]', 'right host';
-is $url->is_ipv4, undef, 'not an IPv4 address';
-is $url->is_ipv6, 1, 'is an IPv6 address';
-$url = Mojo::URL->new('http://127.0.0.1:3000');
-is $url->host, '127.0.0.1', 'right host';
-is $url->is_ipv4, 1, 'is an IPv4 address';
-is $url->is_ipv6, undef, 'not an IPv6 address';
-$url = Mojo::URL->new('http://0::127.0.0.1:3000');
-is $url->host, '0::127.0.0.1', 'right host';
-is $url->is_ipv4, undef, 'not an IPv4 address';
-is $url->is_ipv6, 1, 'is an IPv6 address';
-$url = Mojo::URL->new('http://[0::127.0.0.1]:3000');
-is $url->host, '[0::127.0.0.1]', 'right host';
-is $url->is_ipv4, undef, 'not an IPv4 address';
-is $url->is_ipv6, 1, 'is an IPv6 address';
-$url = Mojo::URL->new('http://foo.1.1.1.1.de/');
-is $url->host, 'foo.1.1.1.1.de', 'right host';
-is $url->is_ipv4, undef, 'not an IPv4 address';
-is $url->is_ipv6, undef, 'not an IPv4 address';
-$url = Mojo::URL->new('http://1.1.1.1.1.1/');
-is $url->host, '1.1.1.1.1.1', 'right host';
-is $url->is_ipv4, undef, 'not an IPv4 address';
-is $url->is_ipv6, undef, 'not an IPv4 address';
-
# Merge relative path
$url = Mojo::URL->new('http://foo.bar/baz?yada');
is $url->base, '', 'no base';
@@ -514,3 +464,29 @@ is $url->path, '/baz/zzz', 'right path';
is $url->query, '', 'right query';
is $url->fragment, undef, 'no fragment';
is "$url", 'http://foo.bar/baz/zzz', 'right absolute URL';
+
+# Hosts
+$url = Mojo::URL->new('http://mojolicio.us');
+is $url->host, 'mojolicio.us', 'right host';
+$url = Mojo::URL->new('http://[::1]');
+is $url->host, '[::1]', 'right host';
+$url = Mojo::URL->new('http://127.0.0.1');
+is $url->host, '127.0.0.1', 'right host';
+$url = Mojo::URL->new('http://0::127.0.0.1');
+is $url->host, '0::127.0.0.1', 'right host';
+$url = Mojo::URL->new('http://[0::127.0.0.1]');
+is $url->host, '[0::127.0.0.1]', 'right host';
+$url = Mojo::URL->new('http://mojolicio.us:3000');
+is $url->host, 'mojolicio.us', 'right host';
+$url = Mojo::URL->new('http://[::1]:3000');
+is $url->host, '[::1]', 'right host';
+$url = Mojo::URL->new('http://127.0.0.1:3000');
+is $url->host, '127.0.0.1', 'right host';
+$url = Mojo::URL->new('http://0::127.0.0.1:3000');
+is $url->host, '0::127.0.0.1', 'right host';
+$url = Mojo::URL->new('http://[0::127.0.0.1]:3000');
+is $url->host, '[0::127.0.0.1]', 'right host';
+$url = Mojo::URL->new('http://foo.1.1.1.1.de/');
+is $url->host, 'foo.1.1.1.1.de', 'right host';
+$url = Mojo::URL->new('http://1.1.1.1.1.1/');
+is $url->host, '1.1.1.1.1.1', 'right host';
@@ -3,13 +3,16 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More;
plan skip_all => 'Windows is too fragile for this test!'
if $^O eq 'MSWin32' || $^O =~ /cygwin/;
-plan tests => 70;
+plan tests => 73;
use_ok 'Mojo::UserAgent';
@@ -246,6 +249,12 @@ is $tx->kept_alive, undef, 'kept connection not alive';
is $tx->res->code, 200, 'right status';
is $tx->res->body, 'works!', 'right content';
+# GET / (built-in server)
+$tx = $ua->get('/');
+ok $tx->success, 'successful';
+is $tx->res->code, 200, 'right status';
+is $tx->res->body, 'works', 'right content';
+
# Nested keep alive
my @kept_alive;
$ua->get(
@@ -3,14 +3,17 @@
use strict;
use warnings;
-# Disable epoll, kqueue and TLS
-BEGIN { $ENV{MOJO_POLL} = $ENV{MOJO_NO_TLS} = 1 }
+# Disable libev and TLS
+BEGIN {
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+ $ENV{MOJO_NO_TLS} = 1;
+}
use Test::More;
plan skip_all => 'set TEST_ONLINE to enable this test (developer only!)'
unless $ENV{TEST_ONLINE};
-plan tests => 96;
+plan tests => 104;
# "So then I said to the cop, "No, you're driving under the influence...
# of being a jerk"."
@@ -154,6 +157,18 @@ is $tx->req->headers->content_length, 17, 'right content length';
is $tx->req->body, 'query=mojolicious', 'right content';
like $tx->res->body, qr/Mojolicious/, 'right content';
is $tx->res->code, 200, 'right status';
+is $tx->keep_alive, 1, 'connection will be kept alive';
+
+# Simple keep alive form post
+$tx =
+ $ua->post_form('http://search.cpan.org/search' => {query => 'mojolicious'});
+is $tx->req->method, 'POST', 'right method';
+is $tx->req->url, 'http://search.cpan.org/search', 'right url';
+is $tx->req->headers->content_length, 17, 'right content length';
+is $tx->req->body, 'query=mojolicious', 'right content';
+like $tx->res->body, qr/Mojolicious/, 'right content';
+is $tx->res->code, 200, 'right status';
+is $tx->kept_alive, 1, 'connection was kept alive';
# Simple request
$tx = $ua->get('http://www.apache.org');
@@ -3,15 +3,18 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More;
-use Mojo::IOLoop;
+use Mojo::IOLoop::Server;
plan skip_all => 'set TEST_TLS to enable this test (developer only!)'
unless $ENV{TEST_TLS};
plan skip_all => 'IO::Socket::SSL 1.43 required for this test!'
- unless Mojo::IOLoop::TLS;
+ unless Mojo::IOLoop::Server::TLS;
plan tests => 14;
# "That does not compute.
@@ -50,12 +53,12 @@ my $id = $ua->ioloop->listen(
my $tx = $ua->get("https://localhost:$port");
ok !$tx->success, 'not successful';
ok $tx->error, 'has error';
-ok $error, 'has error';
+ok !$error, 'no error';
$error = '';
$tx = $ua->cert('')->key('')->get("https://localhost:$port");
ok !$tx->success, 'not successful';
ok $tx->error, 'has error';
-ok $error, 'has error';
+ok !$error, 'no error';
# Valid certificate
$tx =
@@ -85,8 +88,8 @@ $ENV{MOJO_KEY_FILE} = $backup2;
$tx =
$ua->cert('t/mojo/certs/badclient.crt')->key('t/mojo/certs/badclient.key')
->get("https://localhost:$port");
-ok $error, 'has error';
+ok !$error, 'no error';
# Empty certificate
$tx = $ua->cert('no file')->key('no file')->get("https://localhost:$port");
-ok $error, 'has error';
+ok !$error, 'no error';
@@ -3,10 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
+# Disable Bonjour, IPv6 and libev
BEGIN {
- $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1;
- $ENV{MOJO_MODE} = 'development';
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+ $ENV{MOJO_MODE} = 'development';
}
use Test::More tests => 250;
@@ -5,8 +5,11 @@ use warnings;
use utf8;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More tests => 39;
@@ -3,8 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More tests => 9;
@@ -5,10 +5,11 @@ use warnings;
use utf8;
-# Disable Bonjour, IPv6, epoll and kqueue
+# Disable Bonjour, IPv6 and libev
BEGIN {
- $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1;
- $ENV{MOJO_MODE} = 'testing';
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+ $ENV{MOJO_MODE} = 'testing';
}
use Test::More tests => 113;
@@ -3,10 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
+# Disable Bonjour, IPv6 and libev
BEGIN {
- $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1;
- $ENV{MOJO_MODE} = 'development';
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+ $ENV{MOJO_MODE} = 'development';
}
use Test::More tests => 32;
@@ -5,10 +5,11 @@ use warnings;
use utf8;
-# Disable Bonjour, IPv6, epoll and kqueue
+# Disable Bonjour, IPv6 and libev
BEGIN {
- $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1;
- $ENV{MOJO_MODE} = 'testing';
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+ $ENV{MOJO_MODE} = 'testing';
}
# "Who are you, and why should I care?"
@@ -3,8 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More tests => 24;
@@ -3,8 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More tests => 24;
@@ -5,8 +5,11 @@ use warnings;
use utf8;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More tests => 16;
@@ -5,10 +5,11 @@ use warnings;
use utf8;
-# Disable Bonjour, IPv6, epoll and kqueue
+# Disable Bonjour, IPv6 and libev
BEGIN {
- $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1;
- $ENV{MOJO_MODE} = 'testing';
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+ $ENV{MOJO_MODE} = 'testing';
}
# "Who are you, and why should I care?"
@@ -3,8 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More tests => 27;
@@ -5,10 +5,11 @@ use warnings;
use utf8;
-# Disable Bonjour, IPv6, epoll and kqueue
+# Disable Bonjour, IPv6 and libev
BEGIN {
- $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1;
- $ENV{MOJO_MODE} = 'development';
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+ $ENV{MOJO_MODE} = 'development';
}
use Test::More tests => 890;
@@ -3,8 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More tests => 113;
@@ -5,10 +5,11 @@ use warnings;
use utf8;
-# Disable Bonjour, IPv6, epoll and kqueue
+# Disable Bonjour, IPv6 and libev
BEGIN {
- $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1;
- $ENV{MOJO_MODE} = 'development';
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+ $ENV{MOJO_MODE} = 'development';
}
use Test::More tests => 9;
@@ -3,8 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More;
plan skip_all => 'Perl 5.10 or Pod::Simple required for this test!'
@@ -3,10 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
+# Disable Bonjour, IPv6 and libev
BEGIN {
- $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1;
- $ENV{MOJO_MODE} = 'production';
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+ $ENV{MOJO_MODE} = 'production';
}
use Test::More tests => 51;
@@ -3,8 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More tests => 6;
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Test::More tests => 313;
+use Test::More tests => 330;
# "They're not very heavy, but you don't hear me not complaining."
use_ok 'Mojolicious::Routes';
@@ -32,6 +32,10 @@ $r->route('/alternatives/:foo', foo => [qw/0 test 23/])->to(foo => 11);
# /alternatives2/23
$r->route('/alternatives2/:foo', foo => [qw/0 test 23/]);
+# /alternatives3/foo
+# /alternatives3/foobar
+$r->route('/alternatives3/:foo', foo => [qw/foo foobar/]);
+
# /*/test
my $test = $r->route('/:controller/test')->to(action => 'test');
@@ -122,6 +126,10 @@ $r->route('/format7', format => 0)->to(controller => 'us', action => 'wow');
$r->route('/format8', format => 0)
->to(controller => 'us', action => 'doh', format => 'xml');
+# /format9.foo
+# /fomrat9.foobar
+$r->route('/format9', format => [qw/foo foobar/])->to('perl#rocks');
+
# /articles
# /articles.html
# /articles/1
@@ -244,6 +252,17 @@ is $m->path_for('alternatives2foo'), '/alternatives2', 'right path';
is $m->path_for('alternatives2foo', foo => 0), '/alternatives2/0',
'right path';
+# Alternatives with similar start
+$m = Mojolicious::Routes::Match->new(get => '/alternatives3/foo')->match($r);
+is $m->stack->[0]->{foo}, 'foo', 'right value';
+is @{$m->stack}, 1, 'right number of elements';
+is $m->path_for, '/alternatives3/foo', 'right path';
+$m =
+ Mojolicious::Routes::Match->new(get => '/alternatives3/foobar')->match($r);
+is $m->stack->[0]->{foo}, 'foobar', 'right value';
+is @{$m->stack}, 1, 'right number of elements';
+is $m->path_for, '/alternatives3/foobar', 'right path';
+
# Real world example using most features at once
$m = Mojolicious::Routes::Match->new(get => '/articles.html')->match($r);
is $m->stack->[0]->{controller}, 'articles', 'right value';
@@ -445,6 +464,8 @@ is $m->path_for(format => undef), '/format', 'right path';
is $m->path_for(format => 'html'), '/format.html', 'right path';
is $m->path_for(format => 'txt'), '/format.txt', 'right path';
is @{$m->stack}, 1, 'right number of elements';
+
+# Hardcoded format
$m = Mojolicious::Routes::Match->new(get => '/format2.html')->match($r);
is $m->stack->[0]->{controller}, 'you', 'right value';
is $m->stack->[0]->{action}, 'hello', 'right value';
@@ -457,6 +478,8 @@ is $m->stack->[0]->{action}, 'hello_json', 'right value';
is $m->stack->[0]->{format}, 'json', 'right value';
is $m->path_for, '/format2.json', 'right path';
is @{$m->stack}, 1, 'right number of elements';
+
+# Hardcoded format after placeholder
$m = Mojolicious::Routes::Match->new(GET => '/format3/baz.html')->match($r);
is $m->stack->[0]->{controller}, 'me', 'right value';
is $m->stack->[0]->{action}, 'bye', 'right value';
@@ -471,6 +494,8 @@ is $m->stack->[0]->{format}, 'json', 'right value';
is $m->stack->[0]->{foo}, 'baz', 'right value';
is $m->path_for, '/format3/baz.json', 'right path';
is @{$m->stack}, 1, 'right number of elements';
+
+# Format with regex constraint
$m = Mojolicious::Routes::Match->new(GET => '/format4')->match($r);
is @{$m->stack}, 0, 'right number of elements';
$m = Mojolicious::Routes::Match->new(GET => '/format4.txt')->match($r);
@@ -483,6 +508,8 @@ $m = Mojolicious::Routes::Match->new(GET => '/format4.html')->match($r);
is @{$m->stack}, 0, 'right number of elements';
$m = Mojolicious::Routes::Match->new(GET => '/format4.txt.txt')->match($r);
is @{$m->stack}, 0, 'right number of elements';
+
+# Format with constraint alternatives
$m = Mojolicious::Routes::Match->new(GET => '/format5')->match($r);
is @{$m->stack}, 0, 'right number of elements';
$m = Mojolicious::Routes::Match->new(GET => '/format5.txt')->match($r);
@@ -501,6 +528,8 @@ $m = Mojolicious::Routes::Match->new(GET => '/format5.html')->match($r);
is @{$m->stack}, 0, 'right number of elements';
$m = Mojolicious::Routes::Match->new(GET => '/format5.txt.txt')->match($r);
is @{$m->stack}, 0, 'right number of elements';
+
+# Format with constraint and default
$m = Mojolicious::Routes::Match->new(GET => '/format6')->match($r);
is $m->stack->[0]->{controller}, 'us', 'right value';
is $m->stack->[0]->{action}, 'yay', 'right value';
@@ -517,6 +546,8 @@ $m = Mojolicious::Routes::Match->new(GET => '/format6.txt')->match($r);
is @{$m->stack}, 0, 'right number of elements';
$m = Mojolicious::Routes::Match->new(GET => '/format6.txt.html')->match($r);
is @{$m->stack}, 0, 'right number of elements';
+
+# Forbidden format
$m = Mojolicious::Routes::Match->new(GET => '/format7')->match($r);
is $m->stack->[0]->{controller}, 'us', 'right value';
is $m->stack->[0]->{action}, 'wow', 'right value';
@@ -525,6 +556,8 @@ is $m->path_for, '/format7', 'right path';
is @{$m->stack}, 1, 'right number of elements';
$m = Mojolicious::Routes::Match->new(GET => '/format7.html')->match($r);
is @{$m->stack}, 0, 'right number of elements';
+
+# Forbidden format and default
$m = Mojolicious::Routes::Match->new(GET => '/format8')->match($r);
is $m->stack->[0]->{controller}, 'us', 'right value';
is $m->stack->[0]->{action}, 'doh', 'right value';
@@ -534,6 +567,22 @@ is @{$m->stack}, 1, 'right number of elements';
$m = Mojolicious::Routes::Match->new(GET => '/format8.xml')->match($r);
is @{$m->stack}, 0, 'right number of elements';
+# Formats with similar start
+$m = Mojolicious::Routes::Match->new(GET => '/format9.foo')->match($r);
+is $m->stack->[0]->{controller}, 'perl', 'right value';
+is $m->stack->[0]->{action}, 'rocks', 'right value';
+is $m->stack->[0]->{format}, 'foo', 'right value';
+is $m->path_for, '/format9.foo', 'right path';
+is @{$m->stack}, 1, 'right number of elements';
+$m = Mojolicious::Routes::Match->new(GET => '/format9.foobar')->match($r);
+is $m->stack->[0]->{controller}, 'perl', 'right value';
+is $m->stack->[0]->{action}, 'rocks', 'right value';
+is $m->stack->[0]->{format}, 'foobar', 'right value';
+is $m->path_for, '/format9.foobar', 'right path';
+is @{$m->stack}, 1, 'right number of elements';
+$m = Mojolicious::Routes::Match->new(GET => '/format9.foobarbaz')->match($r);
+is @{$m->stack}, 0, 'right number of elements';
+
# Request methods
$m = Mojolicious::Routes::Match->new(get => '/method/get.html')->match($r);
is $m->stack->[0]->{controller}, 'method', 'right value';
@@ -3,8 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More tests => 45;
@@ -3,10 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
+# Disable Bonjour, IPv6 and libev
BEGIN {
- $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1;
- $ENV{MOJO_MODE} = 'testing';
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+ $ENV{MOJO_MODE} = 'testing';
}
use Test::More tests => 26;
@@ -3,23 +3,28 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More;
-use Mojo::IOLoop;
+use Mojo::IOLoop::Server;
+use Mojo::IOLoop::Stream;
plan skip_all => 'set TEST_TLS to enable this test (developer only!)'
unless $ENV{TEST_TLS};
plan skip_all => 'IO::Socket::SSL 1.43 required for this test!'
- unless Mojo::IOLoop::TLS;
+ unless Mojo::IOLoop::Server::TLS;
plan skip_all => 'Windows is too fragile for this test!'
- if Mojo::IOLoop::WINDOWS;
+ if Mojo::IOLoop::Stream::WINDOWS;
plan tests => 18;
# "Look at these low, low prices on famous brand-name electronics!
# Don't be a sap, Dad. These are just crappy knockoffs.
# Pfft. I know a genuine Panaphonics when I see it.
# And look, there's a Magnetbox and Sorny."
+use Mojo::IOLoop;
use Mojo::UserAgent;
use Mojolicious::Lite;
use Test::Mojo;
@@ -3,8 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More;
plan skip_all => 'Perl 5.10 required for this test!'
@@ -5,8 +5,11 @@ use warnings;
use utf8;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More;
plan skip_all => 'Windows is too fragile for this test!'
@@ -3,8 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
# FreeBSD 8.0 and 8.1 are known to cause problems
use Test::More;
@@ -3,8 +3,11 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More tests => 9;
@@ -3,23 +3,28 @@
use strict;
use warnings;
-# Disable Bonjour, IPv6, epoll and kqueue
-BEGIN { $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = $ENV{MOJO_POLL} = 1 }
+# Disable Bonjour, IPv6 and libev
+BEGIN {
+ $ENV{MOJO_NO_BONJOUR} = $ENV{MOJO_NO_IPV6} = 1;
+ $ENV{MOJO_IOWATCHER} = 'Mojo::IOWatcher';
+}
use Test::More;
-use Mojo::IOLoop;
+use Mojo::IOLoop::Server;
+use Mojo::IOLoop::Stream;
plan skip_all => 'set TEST_TLS to enable this test (developer only!)'
unless $ENV{TEST_TLS};
plan skip_all => 'IO::Socket::SSL 1.43 required for this test!'
- unless Mojo::IOLoop::TLS;
+ unless Mojo::IOLoop::Server::TLS;
plan skip_all => 'Windows is too fragile for this test!'
- if Mojo::IOLoop::WINDOWS;
+ if Mojo::IOLoop::Stream::WINDOWS;
plan tests => 15;
# "I was a hero to broken robots 'cause I was one of them, but how can I sing
# about being damaged if I'm not?
# That's like Christina Aguilera singing Spanish.
# Ooh, wait! That's it! I'll fake it!"
+use Mojo::IOLoop;
use Mojo::Server::Daemon;
use Mojo::UserAgent;
use Mojolicious::Lite;